?? pathfile.pas

?? 為青島一家公司做的條碼打印管理
?? PAS
字號(hào):
{
   例程作者：李龍武。版權(quán)歸 lodgue 所有   1999-12-1
   例程說(shuō)明：
}
unit PathFile;

interface

uses
  Windows,SysUtils,ShellAPI,StrProcess,classes;
const
   InvalidPath=' is invalid Path!';
type
  EPathError=class(exception);
  TDriverSet=set of char;
procedure EPath(value,ErrorInfo:string);

{路徑處理/文件名}
function IsValidFileName(FileName:string):boolean; //檢查文件是否合法。
function IsPathWithBackslashChar(Directory:string):boolean; //判斷路徑尾是否存在'\'
function RectifyPath(Directory:string):string; //校正路徑有'\'則不加'\'，無(wú)則加上'\'
function GetFileNameFromFullFileName(FullFileName:string):string;//從一個(gè)帶有路徑的文件名中讀取文件名-不帶有路徑
function GetPathFromFullFileName(FullFileName:string):string;//從一個(gè)帶有路徑的文件名中讀取路徑-不帶有文件名，后帶有‘\’
function GetLongName(ShortName:string):string;//根據(jù)短文件名(8.3)獲取長(zhǎng)文件名 一個(gè)文件名/目錄
function GetShortName(LongName:string):string;//根據(jù)長(zhǎng)文件名獲取斷文件名(8.3) 一個(gè)文件名/目錄
procedure ShortToLong(ShortName:string;var LongName:string);//將完整（含完整的路徑）的短文件文件名轉(zhuǎn)換成長(zhǎng)文件名（其中任何級(jí)目錄都是長(zhǎng)形式）
procedure LongToShort(LongName:string;var ShortName:string);//將完整（含完整的路徑）的長(zhǎng)文件文件名轉(zhuǎn)換成短文件名（其中任何級(jí)目錄都是短形式）
{系統(tǒng)路徑}
function GetWinDir:string;   //獲取window目錄
function GetPathInWindows(path:string):string; //在window目錄中查找某一目錄的完整路徑eg:config->c:\windows\config\
function CheckDocFileOfRegProgram(ExtendName:string):string; //查找打開(kāi)某一文檔的可執(zhí)行程序.(含完整路徑)

{驅(qū)動(dòng)器和硬盤(pán)}
procedure CheckDriveSignSet(var UsedDrvSignSet,UnKnownDrvSignSet,NotExitsDrvSignSet:TDriverSet);//檢查整個(gè)字符(A-Z)的驅(qū)動(dòng)器符號(hào)
function GetUsedDrvSign:TDriverSet; //獲取被用過(guò)的驅(qū)動(dòng)器字符集合
function GetUnKnownDrvSign:TDriverSet;//獲取被不認(rèn)識(shí)的驅(qū)動(dòng)器字符集合
function GetRemainDrvSign:TDriverSet; //獲取沒(méi)用過(guò)的驅(qū)動(dòng)器字符集合

{文件}
//文件的復(fù)制
procedure AutoCopySelf(TargetFile:string); //自動(dòng)復(fù)制自己，注意該文件一定是個(gè)Exe文件


implementation

procedure EPath(value,ErrorInfo:string);
begin
 raise EpathError.Create(Value+ErrorInfo);
end;

/////////////////////////////////////////////////////////////////////////////////////
{路徑處理/文件名}
function IsValidFileName(FileName:string):boolean;   //檢查文件是否合法。
var
  i:integer;
  Tmp:char;
  Invalid:boolean;
begin
  Invalid:=False;
  if FileName='' then Invalid:=True;
  for i:=1 to length(FileName) do begin
    Tmp:=StrToChar(Copy(FileName,i,1));
    Invalid:=Tmp in ['\','/',':','*','?','"','<','>','|'];
    if Invalid then Break;
  end;
  Result:= not Invalid;
end;

function IsPathWithBackslashChar(Directory:string):boolean; //判斷路徑尾是否存在反斜杠'\'
var
  Len:integer;
  EndStr:string;
begin
  Len:=Length(Directory);
  if Directory='' then Epath(Directory,InvalidPath);
  EndStr:=Copy(Directory,Len,1);
  Result:=(StrToChar(EndStr)='\');
end;

function RectifyPath(Directory:string):string;  //校正路徑有'\'則不加'\'，無(wú)則加上'\'
begin
  if not IsPathWithBackslashChar(Directory) then Insert('\',Directory,Length(Directory)+1);
  Result:=Directory;
end;

function GetFileNameFromFullFileName(FullFileName:string):string;//從一個(gè)帶有路徑的文件名中讀取文件名-不帶有路徑
begin
  Result:=GetRightStr(FullFileName,'\');
end;

function GetPathFromFullFileName(FullFileName:string):string;//從一個(gè)帶有路徑的文件名中讀取路徑-不帶有文件名，后帶有‘\’
begin
  Result:=ReplaceRight(FullFileName,'','\');
end;

function GetLongName(ShortName:string):string;//根據(jù)短文件名(8.3)獲取長(zhǎng)文件名 一個(gè)文件名/目錄
var                                           //如果是目錄最后不能帶‘\’.因?yàn)閹稀甛’，就成了路徑
  FindFileData:_WIN32_FIND_DATA;              //FindFirstFile就查不到，返回空值
begin
  if FindFirstFile(PChar(ShortName),FindFileData)<>INVALID_HANDLE_VALUE then begin
    Result:=FindFileData.cFileName;
  end else Result:='';
end;

{
 目錄由長(zhǎng)名字取短名字是為空：windows,A3w_data,A4w_data,Applog,Catroot,Command
     Config,Cursors,Drwatson,Fonts,Help,Inf,Java,Media,Pif,Samples,Sysbckup
     System, System32,Temp,Vcm,Wangsamp
 下一級(jí)目錄和所有文件我沒(méi)有時(shí)間去一個(gè)一個(gè)的測(cè)試。我想一般很少用到它。但很有可能它里面
 一定還有類(lèi)似上面的情況的目錄和文件存在。
 另外，還發(fā)現(xiàn)Ulead.dat目錄臺(tái)灣友立公司的軟件cool 3d建立的一個(gè)目錄
 這給我?guī)?lái)很大的麻煩因?yàn)橛脩?hù)也可以定義類(lèi)似上面的目錄，而我不知道這樣的目錄
 同一般目錄有什么不同。 
}
function GetShortName(LongName:string):string;//根據(jù)長(zhǎng)文件名獲取斷文件名(8.3)  一個(gè)文件名/目錄，
var                                           //如果是目錄最后不能帶‘\’.因?yàn)閹稀甛’，就成了路徑
  FindFileData:_WIN32_FIND_DATA;              //FindFirstFile就查不到，返回空值
  FileName:string;//不包含路徑,可以是目錄
begin
  FileName:=GetFileNameFromFullFileName(LongName);
  if FindFirstFile(PChar(LongName),FindFileData)<>INVALID_HANDLE_VALUE then begin
    Result:=FindFileData.cAlternateFileName;  //注意：如果不存在長(zhǎng)文件名則將cAlternateFileName設(shè)置為空
    if Result='' then begin //如果不存在長(zhǎng)文件名則將原文件名（大寫(xiě)）返回
      Result:=AnsiUpperCase(FileName);
    end;
  end else Result:='';
end;

procedure ShortToLong(ShortName:string;var LongName:string);//將完整（含完整的路徑）的短文件文件名轉(zhuǎn)換成長(zhǎng)文件名（其中任何級(jí)目錄都是長(zhǎng)形式）
var                                                         //一定是合法的路徑否則一律返回空串
  InfoList:TStringList;                                     //路徑的前或后的空格可以忽略。
  PartShortName,PartLongName,PriorPath:string;
  i,CurSpacePos,PriorSpacePos:integer;
  DriverType:integer;
begin  //D:\llw\Pro gram\Virus\B ak
  ShortName:=TrimBoth(ShortName,' ');
  LongName:=Copy(ShortName,1,2);
  DriverType:=GetDriveType(PChar(LongName+'\'));
  if (DriverType=0) or (DriverType=1) then begin
    LongName:='';
    Exit;
  end;
  PriorSpacePos:=Pos('\',ShortName);
  if PriorSpacePos=0 then begin
    if Length(ShortName)<=2 then LongName:=ShortName
    else LongName:='';
    Exit;
  end else begin
    if Length(ShortName)=3 then begin
      LongName:=ShortName;
      Exit;
    end;
    InfoList:=TStringList.Create;
    GetSubInfoInStr(ShortName,'\',True,InfoList);
    for i:=1 to InfoList.Count-1 do begin
      CurSpacePos:=StrToInt(InfoList.Strings[i]);
      PartShortName:=Copy(ShortName,PriorSpacePos+1,CurSpacePos-PriorSpacePos-1);
      PriorPath:=Copy(ShortName,1,PriorSpacePos);
      PartLongName:=GetLongName(PriorPath+PartShortName);
      if PartLongName='' then begin
        LongName:='';
        InfoList.Free;
        Exit;
      end;
      LongName:=LongName+'\'+PartLongName;
      PriorSpacePos:=CurSpacePos;
    end;
    PriorSpacePos:=StrToInt(InfoList.Strings[InfoList.Count-1]);
    PartShortName:=Copy(ShortName,PriorSpacePos+1,Length(ShortName)-PriorSpacePos);
    PriorPath:=Copy(ShortName,1,PriorSpacePos);
    PartLongName:=GetLongName(PriorPath+PartShortName);
    LongName:=LongName+'\'+PartLongName;
    if PartLongName='' then begin
      LongName:='';
      InfoList.Free;
      Exit;
    end;
    InfoList.Free;
  end;
end;




procedure LongToShort(LongName:string;var ShortName:string);//將完整（含完整的路徑）的長(zhǎng)文件文件名轉(zhuǎn)換成短文件名（其中任何級(jí)目錄都是短形式）
var                                                         //一定是合法的路徑否則一律返回空串
  InfoList:TStringList;                                     //路徑的前或后的空格可以忽略。
  PartShortName,PartLongName,PriorPath:string;
  i,CurSpacePos,PriorSpacePos:integer;
  DriverType:integer;
begin  //D:\llw\Pro gram\Virus\B ak
  LongName:=TrimBoth(LongName,' ');
  ShortName:=Copy(LongName,1,2);
  DriverType:=GetDriveType(PChar(ShortName+'\'));
  if (DriverType=0) or (DriverType=1) then begin
    ShortName:='';
    Exit;
  end;
  PriorSpacePos:=Pos('\',LongName);
  if PriorSpacePos=0 then begin
    if Length(LongName)<=2 then ShortName:=LongName
    else ShortName:='';
    Exit;
  end else begin
    if Length(LongName)=3 then begin
      ShortName:=LongName;
      Exit;
    end;
    InfoList:=TStringList.Create;
    GetSubInfoInStr(LongName,'\',True,InfoList);
    for i:=1 to InfoList.Count-1 do begin
      CurSpacePos:=StrToInt(InfoList.Strings[i]);
      PartLongName:=Copy(LongName,PriorSpacePos+1,CurSpacePos-PriorSpacePos-1);
      PriorPath:=Copy(LongName,1,PriorSpacePos);
      PartShortName:=GetShortName(PriorPath+PartLongName);
      if PartShortName='' then begin
        ShortName:='';
        InfoList.Free;
        Exit;
      end;
      ShortName:=ShortName+'\'+PartShortName;
      PriorSpacePos:=CurSpacePos;
    end;
    PriorSpacePos:=StrToInt(InfoList.Strings[InfoList.Count-1]);
    PartLongName:=Copy(LongName,PriorSpacePos+1,Length(LongName)-PriorSpacePos);
    PriorPath:=Copy(LongName,1,PriorSpacePos);
    PartShortName:=GetShortName(PriorPath+PartLongName);
    ShortName:=ShortName+'\'+PartShortName;
    if PartShortName='' then begin
      ShortName:='';
      InfoList.Free;
      Exit;
    end;
    InfoList.Free;
  end;
end;


/////////////////////////////////////////////////////////////////////////////////////
{系統(tǒng)路徑}
function GetPathInWindows(path:string):string;  //在windows目錄下得到一個(gè)由path指定的路徑
var
  MenuPath:string;
  WinPath:string;
begin
  WinPath:=RectifyPath(GetWinDir);
  path:=RectifyPath(Path);
  MenuPath:=WinPath+path;
  Result:=MenuPath;
end;

function GetWinDir:string;  //得到windows目錄路徑
var
  WinPath:array [0..14]of char;
begin
  GetWindowsDirectory(@WinPath,15);
  Result:=WinPath;
  Result:=RectifyPath(Result);
end;

/////////////////////////////////////////////////////////////////////////////////////
{可執(zhí)行程序}
function CheckDocFileOfRegProgram(ExtendName:string):String; //查找打開(kāi)某一文檔的可執(zhí)行程序.(含完整路徑)
var
  pExeName:Pchar;
  f:TextFile;
  pTempPath:Array[0..49]of Char;
  FileName:string;
begin
  GetTempPath(50,pTempPath);
  FileName:=string(pTempPath)+'Test.'+ExtendName;
  if not FileExists(FileName) then begin
    AssignFile(f,FileName);
    Rewrite(f);
    write(f,' ');
    CloseFile(f);
    GetMem(pExeName,1024);
    FindExecutable(PChar(FileName),pTempPath,pExeName);
    Result:=String(pExeName);
    FreeMem(pExeName);
    DeleteFile(FileName);
  end else begin
    GetMem(pExeName,1024);
    FindExecutable(PChar(FileName),pTempPath,pExeName);
    Result:=String(pExeName);
    FreeMem(pExeName);
  end;
end;



/////////////////////////////////////////////////////////////////////////////////////
{關(guān)于驅(qū)動(dòng)器和硬盤(pán)}
 
//驅(qū)動(dòng)器
procedure CheckDriveSignSet(var UsedDrvSignSet,UnKnownDrvSignSet,NotExitsDrvSignSet:TDriverSet);//檢查整個(gè)字符(A-Z)的驅(qū)動(dòng)器符號(hào)
var
  i:char;
  DriverType:integer;
begin
  UsedDrvSignSet:=[];
  UnKnownDrvSignSet:=[];
  NotExitsDrvSignSet:=[];
  for i:='A' to 'Z' do begin
    DriverType:=GetDriveType(PChar(string(i)+':'));
    case DriverType of
      DRIVE_REMOVABLE,DRIVE_FIXED,DRIVE_REMOTE,DRIVE_CDROM,DRIVE_RAMDISK:
         UsedDrvSignSet:=UsedDrvSignSet+[i];
      0: UnKnownDrvSignSet:=UnKnownDrvSignSet+[i];
      1: NotExitsDrvSignSet:=NotExitsDrvSignSet+[i];
    end;
  end;
end;

function GetUsedDrvSign:TDriverSet; //獲取被用過(guò)的驅(qū)動(dòng)器字符集合
var
  UsedDrvSignSet,UnKnownDrvSignSet,NotExitsDrvSignSet:TDriverSet;
begin
  CheckDriveSignSet(UsedDrvSignSet,UnKnownDrvSignSet,NotExitsDrvSignSet);
  Result:=UsedDrvSignSet;
end;

function GetUnKnownDrvSign:TDriverSet;  //獲取被不認(rèn)識(shí)的驅(qū)動(dòng)器字符集合
var
  UsedDrvSignSet,UnKnownDrvSignSet,NotExitsDrvSignSet:TDriverSet;
begin
  CheckDriveSignSet(UsedDrvSignSet,UnKnownDrvSignSet,NotExitsDrvSignSet);
  Result:=UnKnownDrvSignSet;
end;

function GetRemainDrvSign:TDriverSet;  //獲取沒(méi)用過(guò)的驅(qū)動(dòng)器字符集合
var
  UsedDrvSignSet,UnKnownDrvSignSet,NotExitsDrvSignSet:TDriverSet;
begin
  CheckDriveSignSet(UsedDrvSignSet,UnKnownDrvSignSet,NotExitsDrvSignSet);
  Result:=NotExitsDrvSignSet;
end;

procedure AutoCopySelf(TargetFile:string); //自動(dòng)復(fù)制自己，注意該文件一定是個(gè)Exe文件
var
  FullName:string;
begin
  FullName:=ParamStr(0);
  CopyFile(PChar(FullName),PChar(TargetFile),True);
end;
end.
?? 文件大小 269 K
?? 上傳用戶(hù) haorenkv3
?? 所屬分類(lèi) 其他行業(yè)
??? 相關(guān)標(biāo)簽

#家 #條碼 #打印
?? 快捷鍵說(shuō)明

復(fù)制代碼 Ctrl + C
搜索代碼 Ctrl + F
全屏模式 F11
切換主題 Ctrl + Shift + D
顯示快捷鍵 ?
增大字號(hào) Ctrl + =
減小字號(hào) Ctrl + -
亚洲欧美第一页_禁久久精品乱码_粉嫩av一区二区三区免费野_久草精品视频

?? pathfile.pas

?? 快捷鍵說(shuō)明
