急!如何让程序只检测光驱路径?(100分)

  • 主题发起人 主题发起人 ltwan
  • 开始时间 开始时间
L

ltwan

Unregistered / Unconfirmed
GUEST, unregistred user!
我正在做一个图片管理程序,现在有一个问题急需解决:
数据表里有一个字段,储存着要浏览的图片的绝对路径,而所有图片都被刻录在
光碟里,当我的程序移殖到另一台机时,除非光驱盘符一样,否则,要浏览图片,就会找不到文件。我现在想改为相对路径,并且只对本机所有光驱进行图片文件搜索,光驱没有就算找不到文件。如:d:,e:为光驱,我要找的文件名在e:/image/file001.jpg,我想数据库里只存'image/file001.jpg',而每次查找文件时,程序都能先从本机的第一个光驱开始查,没有时再查下一个光驱,直到查完所有光驱。
请问各位高手有何解决办法,本人才疏学浅,望指点!最好附送代码。
 
function AvailableDrives: TStringList;
var
i: Integer;
C: String;
DType: Integer;
DriveString: String;
begin
result:= TStringList.Create;
(* Zeichen 65 = A und 90 = Z -- Schleife durch alle m鰃lichen Laufwerke *)
for i := 65 to 90 do
begin
(* Aktuellen Schleifenindex in entsprechenden Laufwerksbezeichner wandeln *)
C := chr(i)+':/';

(* Die Funktion GetDriveType() ermittelt den Medientyp des Laufwerks *)
DType := GetDriveType(PChar(C));

(* Ermittelten Medientyp auswerten und entsprechende Meldung generieren *)
case DType of
0: DriveString:= C+' Unbekannter Laufwerkstyp';
1: DriveString:= C+' Kein Stammverzeichnis gefunden';
DRIVE_REMOVABLE: DriveString:= C+' Wechseldatentr鋑er';
DRIVE_FIXED: DriveString:= C+' Festplatte';
DRIVE_REMOTE: DriveString:= C+' Netzwerklaufwerk';
DRIVE_CDROM: DriveString := C+' CD-ROM Laufwerk';
DRIVE_RAMDISK: DriveString := C+' RAM Disk';
end;
(* G黮tige Laufwerksbezeichner in Liste aufnehmen *)
if not ((DType = 0) or (DType = 1)) then result.Add(DriveString);
end;
end;
这个函数可以得到所以驱动器的盘符列表,你只要改改,只取DRIVE_CDROM类型的,就是光驱的了。
 
unit Unit1;

interface

uses
Windows, Messages, FileCtrl,SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ComCtrls, StdCtrls, ImgList, ExtCtrls;

type
TForm1 = class(TForm)
TreeView: TTreeView;
Button3: TButton;
procedure Button3Click(Sender: TObject);
private
{ Private declarations }
public
procedure CreateDirectoryTree(RootDir, RootCaption: string);
end;

var
Form1: TForm1;

implementation

{$R *.DFM}
procedure TForm1.CreateDirectoryTree(RootDir, RootCaption: string);
procedure AddSubDirToTree(RootNode: TTreeNode);
var
SearchRec: TSearchRec;
Path: string;
Found: integer;
begin
Path := PChar(RootNode.Data) + '/*.*';
Found := FindFirst(Path, faAnyFile, SearchRec);
while Found = 0 do
begin
if (SearchRec.Attr = faDirectory) and (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then
AddSubDirToTree(TreeView.Items.AddChildObject(RootNode, SearchRec.Name,
PChar(PChar(RootNode.Data) + '/' + SearchRec.Name)));
Found := FindNext(SearchRec);
end;
FindClose(SearchRec);
end;
begin
//TreeView.Items.Clear;
AddSubDirToTree(TreeView.Items.AddObject(nil, RootCaption, PChar(RootDir)));
end;

procedure TForm1.Button3Click(Sender: TObject);
var
i:integer;
abc:Tstrings;
s:string;
begin
abc:=TStringlist.Create;
for i:=0 to 23 do begin
s := Chr(65+i)+':/';
if GetDriveType(PChar(s))= DRIVE_cdrom then//如果是光区就遍历所有的光驱下的目录
if directoryexists(s) then
begin
s:=copy(s,0,2) ;
abc.Add(s);
end;
end;
for i:=0 to abc.Count-1 do
BEGIN
S:=abc.strings;
CreateDirectoryTree(S, '['+s+'/]');
END
end;


end.


DRIVE_UNKNOWN:
DRIVE_NO_ROOT_DIR:
DRIVE_REMOVABLE:
DRIVE_FIXED:
DRIVE_REMOTE:
DRIVE_CDROM:
DRIVE_RAMDISK:
 
谢谢你们!
 
后退
顶部