unit RpSysUtils;

interface
uses
  Sysutils, Windows, ShellApi, classes, FileCtrl, Dialogs, forms;

type
  TDriveState = (DS_NO_DISK, DS_UNFORMATTED_DISK,
      DS_EMPTY_DISK, DS_DISK_WITH_FILES);

  function DriveState(DrvLetter: Char): TDriveState;
  function DeleteDir(Dir: string): boolean;
  function StartProcessAndWait(ProcName: string): boolean;
  function StartProcessAndWaitEx(ProcName: string; ShowMode: word): boolean;
  function StartProcessEx(ProcName: string; ShowMode: word; WaitFlag: boolean): boolean;
  function WindowsCopyFile(FromFile, ToDir : string) : boolean;
  procedure rpDelay(ms: Cardinal);



implementation

function DriveState(DrvLetter: Char): TDriveState;
var
  Mask: String[6];
  SearchRec: TSearchRec;
  oldMode: Cardinal;
  ReturnCode: Integer;
begin
  oldMode := SetErrorMode(SEM_FAILCRITICALERRORS);
  Mask := '?:\*.*';
  Mask[1] := DrvLetter;
  {$I-}  { отключить обработку исключительных ситуаций }
  ReturnCode := FindFirst(Mask, faAnyfile, SearchRec);
  SysUtils.FindClose(SearchRec);

  {$I+}
  case ReturnCode of
    { как минимум один файл был найден }
    0: Result := DS_DISK_WITH_FILES;

    { файлов не найдено и дискета в порядке }
    -18: Result := DS_EMPTY_DISK;

    { DS_NO_DISK для DOS, ERROR_NOT_READY для WinNT, ERROR_PATH_NOT_FOUND для Win 3.1 }
    -21, -3: Result := DS_NO_DISK;
  else
    { дискета лежит в дисководе но она не форматировнная }
    Result := DS_UNFORMATTED_DISK;
  end;
  SetErrorMode(oldMode);
end; { DriveState }


{ Удалить каталог со всем содержимым }
function DeleteDir(Dir  : string)  : boolean;
Var
 Found  : integer;
 SearchRec : TSearchRec;
begin
  result:=false;
  if IOResult=0 then ChDir(Dir);
  if IOResult<>0 then exit;

  Found := FindFirst('*.*', faAnyFile, SearchRec);
  while Found = 0 do begin
    if (SearchRec.Name<>'.')and(SearchRec.Name<>'..') then
      if (SearchRec.Attr and faDirectory)<>0 then begin
        if not DeleteDir(SearchRec.Name) then exit;
      end else begin
        if FileSetAttr(SearchRec.Name, $20) <> 0 then exit;
        if not DeleteFile(PChar(SearchRec.Name)) then exit;
      end;
    Found := FindNext(SearchRec);
  end;
  SysUtils.FindClose(SearchRec);
  ChDir('..'); RmDir(Dir);
  result := IOResult = 0;
end;


function StartProcessEx(ProcName: string; ShowMode: word; WaitFlag: boolean): boolean;
var
  si:STARTUPINFO;
  pi:PROCESS_INFORMATION;
  s: string;
begin
  result := false;
  ZeroMemory(@si,sizeof(si));

  si.cb:=SizeOf(si);
  si.dwFlags := STARTF_USESHOWWINDOW;
  si.wShowWindow := ShowMode;

  s := ProcName;
  if CreateProcess(nil, PChar(s), nil, nil, false, 0, nil, nil, si, pi) then begin
    if WaitFlag then WaitForSingleObject(pi.hProcess, INFINITE);
    result := true;
  end;
end;

function StartProcessAndWaitEx(ProcName: string; ShowMode: word): boolean;
begin
  result := StartProcessEx(ProcName, ShowMode, true);
end;

function StartProcessAndWait(ProcName: string): boolean;
begin
  result := StartProcessAndWaitEx(ProcName, SW_HIDE);
end;



function WindowsCopyFile(FromFile, ToDir : string) : boolean;
Var
  S,T: TFileStream;
Begin
  result:=false;
  S := TFileStream.Create(FromFile, fmOpenRead );
  try
    T := TFileStream.Create(ToDir + '\' + ExtractFileName(FromFile), fmOpenWrite or fmCreate);
    try
      T.CopyFrom(S, S.Size ) ;
      if FileSetDate(T.Handle, FileGetDate(S.Handle)) = 0 then
        result:=true;
    finally
      T.Free;
    end;
  finally
    S.Free;
  end;
end;



procedure rpDelay(ms: Cardinal);
var
  i: cardinal;
begin
  i:=GetTickCount;
  repeat
    sleep(1);
    Application.ProcessMessages;
  until GetTickCount - i >= ms;
end;

end.