2008. február 21., csütörtök
Long file names - short file names
Problem/Question/Abstract:
Long file names - short file names
Answer:
Here's a way to convert between short (8.3 DOS file names) and long file names:
{$APPTYPE console}
program LongShrt;
uses
Windows, SysUtils;
function GetShortName(sLongName: string): string;
var
sShortName: string;
nShortNameLen: integer;
begin
SetLength(sShortName, MAX_PATH);
nShortNameLen := GetShortPathName(PChar(sLongName),
PChar(sShortName), MAX_PATH - 1);
if nShortNameLen = 0 then
begin
{ handle errors... }
end;
SetLength(sShortName, nShortNameLen);
Result := sShortName;
end;
function GetLongName(sShortName: string; var bError: boolean): string;
var
bAddSlash: boolean;
SearchRec: TSearchRec;
nStrLen: integer;
begin
bError := False;
Result := sShortName;
nStrLen := Length(sShortName);
bAddSlash := False;
if sShortName[nStrLen] = '\' then
begin
bAddSlash := True;
SetLength(sShortName, nStrLen - 1);
dec(nStrLen);
end;
if ((nStrLen - Length(ExtractFileDrive(sShortName))) > 0) then
begin
if FindFirst(sShortName, faAnyFile, SearchRec) = 0 then
begin
Result := ExtractFilePath(sShortName) + SearchRec.name;
if bAddSlash then
begin
Result := Result + '\';
end;
end
else
begin
// handle errors... bError := True;
end;
FindClose(SearchRec);
end;
end;
function GetLongName(sShortName: string): string;
var
s: string;
p: integer;
bError: boolean;
begin
Result := sShortName;
s := '';
p := Pos('\', sShortName);
while (p > 0) do
begin
s := GetLongName(s + Copy(sShortName, 1, p), bError);
Delete(sShortName, 1, p);
p := Pos('\', sShortName);
if (bError) then
Exit;
end;
if sShortName <> '' then
begin
s := GetLongName(s + sShortName, bError);
if bError then
Exit;
end;
Result := s;
end;
const
csTest = 'C:\program Files';
var
sShort,
sLong: string;
begin
sShort := GetShortName(csTest);
WriteLn('Short name for "' + csTest +
'" is "' + sShort + '"');
WriteLn;
sLong := GetLongName(sShort);
WriteLn('Long name for "' + sShort + '" is "' + sLong + '"');
end.
Feliratkozás:
Megjegyzések küldése (Atom)
Nincsenek megjegyzések:
Megjegyzés küldése