source: oup/releases/0.29a3/TFileTypeRegistration/SysUtils.inc@ 1009

function fileexists(const szFilename: string): boolean;
var
  Handle   : THandle;
  FindData : TWin32FindData;
begin
  Handle := FindFirstFile(pchar(szFilename),FindData);
  Result := (Handle <> INVALID_HANDLE_VALUE);

  if(Result) then Windows.FindClose(Handle);
end;

function ExtractFileDrive(const szFilename: string): string;
var
  i : integer;
begin
  Result := '';
  i      := length(szFilename);
  while(i > 0) do
  begin
    if(szFileName[i] = ':') then
    begin
      Result := copy(szFilename,1,i);
      break;
    end;

    dec(i);
  end;
end;

function ExtractFilePath(const szFilename: string): string;
var
  i : integer;
begin
  Result := '';
  i      := length(szFileName);
  while(i > 0) do
  begin
    if(szFileName[i] = ':') or
      (szFileName[i] = '\') then
    begin
      Result := copy(szFileName,1,i);
      break;
    end;

    dec(i);
  end;
end;

function ExtractFileName(const szFilename: string): string;
var
  i : integer;
begin
  i := length(szFilename);
  while(i > 0) do
  begin
    if(szFilename[i] = '\') then
      break;

    dec(i);
  end;

  Result := copy(szFilename,i + 1,length(szFilename));
end;

function CutFileExt(const szFilename: string): string;
var
  i : integer;
begin
  i := length(szFilename);
  while(i > 0) do
  begin
    if(szFilename[i] = '.') then
      break;

    dec(i);
  end;

  if(i = 0) then Result := szFilename
    else Result := copy(szFilename,1,i-1);
end;

function ChangeFileExt(const szFileName, szNewExt: string): string;
begin
  Result := CutFileExt(szFileName);

  if(szNewExt[1] <> '.') then Result := Result + '.' + szNewExt
    else Result := Result + szNewExt;
end;

function FileSearch(const Name, DirList: string): string;
var
  I, P, L: Integer;
begin
  Result := Name;
  P      := 1;
  L      := length(DirList);

  while(true) do begin
    if(fileexists(Result)) then exit;

    while(P <= L) and (DirList[P] = ';') do inc(P);
    if(P > L) then break;

    I := P;
    while(P <= L) and (DirList[P] <> ';') do inc(P);

    Result   := copy(DirList,I,P-I);
    if not(Result[length(Result)] in[':','\']) then
      Result := Result + '\';

    Result := Result + Name;
  end;

  Result  := '';
end;

function StrToIntDef(const s: string; const i: integer): integer;
var
  code : integer;
begin
  Val(s,Result,code); if(code <> 0) then
                        Result := i;
end;

function IntToStr(const i: integer): string;
begin
  Str(i,Result);
end;

// -----------------------------------------------------------------------------

function Format(fmt: string; params: array of const): string;
var
  pdw1,
  pdw2 : PDWORD;
  i    : integer;
  pc   : PCHAR;
begin
  pdw1 := nil;

  if High(params) >= 0 then
    GetMem(pdw1, (High(params) + 1) * sizeof(Pointer));

  pdw2  := pdw1;
  for i := 0 to High(params) do
    begin
      pdw2^ := PDWORD(@params[i])^;
      inc(pdw2);
    end;

  pc := GetMemory(1024);
  if Assigned(pc) then
    try
      SetString(Result, pc, wvsprintf(pc, PCHAR(fmt), PCHAR(pdw1)));
    finally
      if (pdw1 <> nil) then FreeMem(pdw1);
      FreeMem(pc);
    end
  else
    Result := '';
end;


// -----------------------------------------------------------------------------

function UpperCase(const s: string): string;
var
  i : integer;
begin
  Result := '';

  if(length(s) > 0) then
    begin
      SetLength(Result,length(s));
      for i := 1 to length(s) do
        Result[i] := UpCase(s[i]);
    end;
end;

function LowerCase(const s: string): string;
var
  i : integer;
begin
  Result := '';

  if(length(s) > 0) then
    begin
      SetLength(Result,length(s));
      for i := 1 to length(s) do
        case s[i] of
          'A'..'Z','Ä','Ö','Ü':
            Result[i] := CHR(BYTE(s[i]) + 32);
          else
            Result[i] := s[i];
        end;
    end;
end;

function LoggedUser: string;
var
  dwLen  : dword;
  fTest  : boolean;
begin
  Result := '';
  dwLen  := MAX_PATH; SetLength(Result,dwLen);

  fTest  := GetUserName(@Result[1],dwLen);

  if(not fTest) and (GetLastError = ERROR_MORE_DATA) then begin
    SetLength(Result,dwLen);
    fTest := GetUserName(@Result[1],dwLen);
  end;

  if(fTest) and (Result[1] <> #0) then
    SetLength(Result,dwLen - 1);
end;

// -----------------------------------------------------------------------------

//
// delete files during next reboot (code by sakura)
//
function DeleteFileDuringNextSystemBoot(aFileName: string): Boolean;
var
  ShortName,
  winini    : string;
  os        : TOSVersionInfo;
  ts        : array of string;
  f         : TextFile;
  i         : integer;
begin
  Result := False;

  // get OS version
  os.dwOSVersionInfoSize := sizeof(TOSVersionInfo);
  GetVersionEx(os);

  case os.dwPlatformId of
    // NT systems
    VER_PLATFORM_WIN32_NT:
      Result := MoveFileEx(pchar(aFileName),nil,
        MOVEFILE_REPLACE_EXISTING + MOVEFILE_DELAY_UNTIL_REBOOT);
    // 9x systems
    VER_PLATFORM_WIN32_WINDOWS:
      begin
        // get Windows folder
        SetLength(winini,MAX_PATH+1);
        SetLength(winini,GetWindowsDirectory(@winini[1],MAX_PATH+1));

        if(winini <> '') then begin
          if(winini[length(winini)] <> '\') then
            winini := winini + '\';
          winini   := winini + 'wininit.ini';

          // get short name of the given file
          SetLength(ShortName,MAX_PATH+1);
          SetLength(ShortName,
            GetShortPathName(@aFilename[1],@ShortName[1],MAX_PATH+1));

          if(ShortName <> '') then begin
            // add it to "wininit.ini" to delete
            // during next reboot
            SetLength(ts,0);

            {$I-}
            // get old file´s content
            AssignFile(f,winini);
            ReSet(f);
            if(IoResult = 0) then begin
              while(not eof(f)) do begin
                SetLength(ts,length(ts)+1);
                ReadLn(f,ts[length(ts)-1]);

                if(lstrcmpi('[rename]',pchar(ts[length(ts)-1])) = 0) then begin
                  SetLength(ts,length(ts)+1);
                  ts[length(ts)-1] := 'NUL='+ShortName;
                end;
              end;
              CloseFile(f);
            end;

            if(length(ts) = 0) then begin
              SetLength(ts,2);
              ts[0] := '[rename]';
              ts[1] := 'NUL='+ShortName;
            end;

            // re-create
            ReWrite(f);
            Result := (IoResult = 0);
            if(Result) then begin
              for i := 0 to length(ts) - 1 do
                WriteLn(f,ts[i]);

              CloseFile(f);
            end;
            {$I+}

            SetLength(ts,0);
          end;
        end;
      end;
    // only 9x and NT are supported
    else
      exit;
  end;
end;