dws2mflibfuncs.pas

script language

      (desc <> '') then
      Liste.Add(Datei + ' ' + desc);

    if Liste.Count = 0 then
    begin
      if FileExists(Pfad) then
        DeleteFile(CPfad);
    end
    else
      Liste.SaveToFile(Pfad);
    Liste.Free;

    if FileExists(Pfad) then
      SetFileAttributes(CPfad, FILE_ATTRIBUTE_HIDDEN);

    Result := True;
  except
    Result := False;
  end;
end;

function DirectoryExists(const Name: string): Boolean;
var
  Code: Integer;
begin
  Code := GetFileAttributes(PChar(Name));
  Result := (Code <> -1) and (FILE_ATTRIBUTE_DIRECTORY and Code <> 0);
end;

function FileDate(const FileName: string; Flag: Integer): TDateTime;
var
  H : THandle;
  FindData : TWin32FindData;
  function _FileDateToDateTime(FileTime: TFileTime): TDateTime;
  var
    LocalFileTime : TFileTime;
    DosTime : Integer;
  begin
    Result := 0;
    FileTimeToLocalFileTime( FileTime, LocalFileTime );
    if FileTimeToDosDateTime( LocalFileTime, LongRec( DosTime ).Hi, LongRec( DosTime ).Lo ) then
      Result := FileDateToDateTime( DosTime );
  end;
begin
  Result := 0;
  H := FindFirstFile( PChar( FileName ), FindData );
  if H <> INVALID_HANDLE_VALUE then
  begin
    case Flag of
      FILEDATE_CREATION:
        Result := _FileDateToDateTime( FindData.ftCreationTime );
      FILEDATE_LASTACCESS:
        Result := _FileDateToDateTime( FindData.ftLastAccessTime );
      FILEDATE_LASTWRITE:
        Result := _FileDateToDateTime( FindData.ftLastWriteTime );
    end;
    Windows.FindClose( H );
  end;
end;

function FileSize(const FileName: string): Int64;
var
  H: THandle;
  FindData: TWin32FindData;
begin
  Result := -1;
  H := FindFirstFile(PChar(FileName), FindData);
  if H <> INVALID_HANDLE_VALUE then
  begin
    if (FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = 0 then
      Result := (FindData.nFileSizeHigh * MAXWORD) + FindData.nFileSizeLow;
    Windows.FindClose(H);
  end;
end;

function MakePath(const Drive, Dir, Name, Ext: string): string;
var
  i: Integer;
begin
  Result := Drive;
  i := Length(Result);
  if (i > 0) then
  begin
    if IsPathDelimiter(Result, i) then
    begin
      if IsPathDelimiter(Dir, 1) then
        SetLength(Result, i - 1);
    end
    else if not IsDelimiter(':', Result, i) and
      not IsPathDelimiter(Dir, 1) then
      Result := Result + '\';

  end;

  Result := Result + Dir;
  if not IsPathDelimiter(Result, Length(Result) - 1) then
    Result := Result + '\';

  Result := Result + Name;

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

function ReadOnlyPath(const Path: string): Boolean;
var
  Name: string;
  Handle: TextFile;
  i: Integer;
begin
  Result := True;

  for i := 0 to MaxInt do
  begin
    Name := MakePath('', Path, Format('ROtmp%d', [i]), '.tmp');
    if not FileExists(Name) then
    begin
      AssignFile(Handle, Name);
{$I-}
      Rewrite(Handle);
{$I+}
      if IOResult = 0 then
      begin
        CloseFile(Handle);
        DeleteFile(Name);
        Result := False;
      end;
      Exit;
    end;
  end;
end;

procedure SplitPath(const Path: string; var Drive, Dir, Name, Ext: string);
var
  i: Integer;
begin
  i := LastDelimiter('\:', Path);
  Name := Copy(Path, i + 1, MaxInt);
  i := LastDelimiter('.', Name);
  if (i > 0) then
  begin
    Ext := Copy(Name, i, MaxInt);
    Delete(Name, i, MaxInt);
  end
  else
    Ext := '';
  Dir := ExtractFileDir(Path);
  Drive := ExtractFileDrive(Dir);
  Delete(Dir, 1, Length(Drive));
end;

function SubdirectoryExists(const Dir: string): Boolean;
var
  FindHandle: THandle;
  FindData: TWin32FindData;
  Erg: Boolean;
begin
  Result := False;
  if not DirectoryExists(Dir) then
    Exit;

  FindHandle := FindFirstFile(PChar(Dir + '\*'), FindData);
  if FindHandle <> INVALID_HANDLE_VALUE then
  try
    Erg := True;
    while Erg do
    begin
      if ((FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) > 0) and
        not ((FindData.cFileName[0] = #46) and
        ((FindData.cFileName[1] = #0) or
        ((FindData.cFileName[1] = #46) and
        (FindData.cFileName[2] = #0)))) then
      begin
        Result := True;
        Exit;
      end;
      Erg := FindNextFile(FindHandle, FindData);
    end;
  finally
    Windows.FindClose(FindHandle);
  end;
end;

function ScanForFiles(Filename: string; Recurse, Hidden, IncludeFiles, IncludeDirs:
  Boolean): TStringList;
var
  FindHandle: THandle;
  FindData: TWin32FindData;
  Erg: Boolean;
  paths: TStringList;
  dirpath,
    wildcard,
    pathspec: string;
  i: Integer;
begin
  Result := TStringList.Create;
  try
    paths := nil;

    try
      try
        dirpath := Trim(ExtractFileDir(FileName));
        if dirpath = '' then
          dirpath := GetCurrentDir;
        wildcard := Trim(ExtractFileName(FileName));

        if dirpath[Length(dirpath)] = '\' then
          dirpath := Copy(dirpath, 1, Length(dirpath) - 1);

        if not DirectoryExists(dirpath) then
          Exit;

        if wildcard = '' then
          wildcard := '*';

        paths := TStringList.Create;
        paths.Add(dirpath);

        i := 0;
        while i < paths.Count do
        begin
          dirpath := paths[i];
          Inc(i);
          pathspec := dirpath + '\*';
          FindHandle := FindFirstFile(PChar(pathspec), FindData);
          if FindHandle <> INVALID_HANDLE_VALUE then
          try
            Erg := True;
            while Erg do
            begin
              if not ((FindData.cFileName[0] = #46) and
                ((FindData.cFileName[1] = #0) or
                ((FindData.cFileName[1] = #46) and
                (FindData.cFileName[2] = #0)))) then
              begin
                if ((FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) <> 0)
                  then
                begin
                  if Hidden or
                    (((FindData.dwFileAttributes and FILE_ATTRIBUTE_HIDDEN) = 0)
                      and
                    ((FindData.dwFileAttributes and FILE_ATTRIBUTE_SYSTEM) = 0))
                      then
                  begin
                    if IncludeDirs then
                      Result.Add(dirpath + '\' + string(FindData.cFileName));
                    if Recurse then
                      paths.Insert(i, dirpath + '\' + string(FindData.cFileName));
                  end;
                end
                else if IncludeFiles then
                  if (wildcard = '*') or CmpWC(string(FindData.cFileName),
                    wildcard, True) then
                  begin
                    if Hidden or
                      (((FindData.dwFileAttributes and FILE_ATTRIBUTE_HIDDEN) = 0)
                        and
                      ((FindData.dwFileAttributes and FILE_ATTRIBUTE_SYSTEM) = 0))
                        then
                    begin
                      Result.Add(dirpath + '\' + string(FindData.cFileName));
                    end;
                  end;
              end;
              Erg := FindNextFile(FindHandle, FindData);
            end;
          finally
            Windows.FindClose(FindHandle);
          end;
        end;
      except
        Result.Clear;
      end;
    finally
      paths.Free;
    end;
    Result.Sort;
  except
    ;
  end;
end;

function CDClose(Drive: Integer): Boolean; overload;
var
  D: string;
begin
  if Drive = 0 then
    Result := CDClose('')
  else
  begin
    D := 'A:';
    D[1] := Chr(Drive + 64);
    Result := CDClose(D);
  end;
end;

function CDClose(Drive: string): Boolean; overload;
var
  Res: MciError;
  OpenParm: TMCI_Open_Parms;
  Flags: DWord;
  DeviceID: Word;
begin
  Result := False;
  Flags := mci_Open_Type or mci_Open_Element;
  with OpenParm do
  begin
    dwCallback := 0;
    lpstrDeviceType := 'CDAudio';
    if Drive = '' then
      lpstrElementName := PChar(ExtractFileDrive(GetCurrentDir))
    else
      lpstrElementName := PChar(ExtractFileDrive(Drive));
  end;
  Res := mciSendCommand(0, mci_Open, Flags, Longint(@OpenParm));
  if Res <> 0 then
    Exit;
  DeviceID := OpenParm.wDeviceID;
  try
    Res := mciSendCommand(DeviceID, MCI_SET, MCI_SET_DOOR_CLOSED, 0);
    if Res = 0 then
      Exit;
    Result := True;
  finally
    mciSendCommand(DeviceID, mci_Close, Flags, Longint(@OpenParm));
  end;
end;

function CDOpen(Drive: Integer): Boolean; overload;
var
  D: string;
begin
  if Drive = 0 then
    Result := CDOpen('')
  else
  begin
    D := 'A:';
    D[1] := Chr(Drive + 64);
    Result := CDOpen(D);
  end;
end;

function CDOpen(Drive: string): Boolean; overload;
var
  Res: MciError;
  OpenParm: TMCI_Open_Parms;
  Flags: DWord;
  DeviceID: Word;
begin
  Result := False;
  Flags := mci_Open_Type or mci_Open_Element;
  with OpenParm do
  begin
    dwCallback := 0;
    lpstrDeviceType := 'CDAudio';
    if Drive = '' then
      lpstrElementName := PChar(ExtractFileDrive(GetCurrentDir))
    else
      lpstrElementName := PChar(ExtractFileDrive(Drive));
  end;
  Res := mciSendCommand(0, mci_Open, Flags, Longint(@OpenParm));
  if Res <> 0 then
    Exit;
  DeviceID := OpenParm.wDeviceID;
  try
    Res := mciSendCommand(DeviceID, MCI_SET, MCI_SET_DOOR_OPEN, 0);
    if Res = 0 then
      Exit;
    Result := True;
  finally
    mciSendCommand(DeviceID, mci_Close, Flags, Longint(@OpenParm));
  end;
end;

function DriveName(Drive: Integer): string; overload;
var
  N: array[0..MAX_PATH] of Char;
  D: string;
  L: Cardinal;
begin
  N[0] := #0;
  if Drive = 0 then
    GetVolumeInformation(nil, N, MAX_PATH, nil, L, L, nil, 0)
  else
  begin
    D := 'A:\';
    D[1] := Chr(Drive + 64);
    GetVolumeInformation(PChar(D), N, MAX_PATH, nil, L, L, nil, 0);
  end;
  Result := string(N);
end;

function DriveName(Drive: string): string; overload;
var
  N: array[0..MAX_PATH] of Char;
  D: string;
  L: Cardinal;
begin
  N[0] := #0;
  if Drive = '' then
    GetVolumeInformation(nil, N, MAX_PATH, nil, L, L, nil, 0)
  else
  begin
    D := ExtractFileDrive(Drive) + '\';
    GetVolumeInformation(PChar(D), N, MAX_PATH, nil, L, L, nil, 0);
  end;
  Result := string(N);
end;

function DriveReady(Drive: Integer): Boolean; overload;
var
  ErrorMode: WORD;
begin
  Result := False;
  ErrorMode := SetErrorMode(SEM_FailCriticalErrors);
  try
    if DiskSize(Drive) > -1 then
      Result := True;
  finally
    SetErrorMode(ErrorMode);
  end;
end;

function DriveReady(Drive: string): Boolean; overload;
var
  ErrorMode: WORD;
  I: Integer;
begin
  Result := False;

  if Drive = '' then
    I := 0
  else
    I := Ord(UpCase(Drive[1])) - 64;
  ErrorMode := SetErrorMode(SEM_FailCriticalErrors);
  try
    if DiskSize(I) > -1 then
      Result := True;
  finally
    SetErrorMode(ErrorMode);
  end;
end;

function DriveSerial(Drive: Integer): string; overload;
var
  D: string;
begin
  if Drive = 0 then
    Result := DriveSerial('')
  else
  begin
    D := 'A:';
    D[1] := Chr(Drive + 64);
    Result := DriveSerial(D);
  end;
end;

function DriveSerial(Drive: string): string; overload;
var
  VolumeSerialNumber,
    MaximumComponentLength,
    FileSystemFlags: DWord;
  D: array[0..3] of Char;
begin
  StrPCopy(D, ExtractFileDrive(Drive) + '\');
  GetVolumeInformation(D,
    nil,
    0,
    @VolumeSerialNumber,
    MaximumComponentLength,
    FileSystemFlags,
    nil,
    0);
  Result := IntToHex(HiWord(VolumeSerialNumber), 4) +
    '-' +
    IntToHex(LoWord(VolumeSerialNumber), 4);
end;

function DriveType(Drive: Integer): Integer; overload;
var
  D: string;
begin
  if Drive = 0 then
    Result := GetDriveType(nil)
  else
  begin
    D := 'A:\';
    D[1] := Chr(Drive + 64);
    Result := GetDriveType(PChar(D));
  end;
end;

function DriveType(Drive: string): Integer; overload;
var
  D: string;
begin
  if Drive = '' then
    Result := GetDriveType(nil)
  else
  begin
    D := ExtractFileDrive(Drive) + '\';
    Result := GetDriveType(PChar(D));
  end;
end;

function GetWindowsVersion: Integer;
var
  VersionInfo: TOsVersionInfo;
begin
  Result := VER_UNKNOWN;

  VersionInfo.dwOSVersionInfoSize := SizeOf(VersionInfo);
  GetVersionEx(VersionInfo);
  with VersionInfo do
  begin
    case dwPlatformId of
      VER_PLATFORM_WIN32s:
        begin
          Result := VER_WIN32S;
        end;
      VER_PLATFORM_WIN32_WINDOWS:
        begin
          Result := VER_WIN95;
          if (dwMajorVersion >= 4) then
            if (dwMinorVersion >= 90) then
              Result := VER_WINME
            else if (dwMinorVersion >= 10) then
              Result := VER_WIN98;
        end;
      VER_PLATFORM_WIN32_NT:
        begin
          if VersionInfo.dwMajorVersion >= 5 then
            Result := VER_WIN2000
          else if VersionInfo.dwMajorVersion = 4 then
            Result := VER_WINNT4
          else
            Result := VER_WINNT;
        end;
    end;
  end;
end;

function IsWin2000: Boolean;
begin
  Result := GetWindowsVersion and VER_WIN2000 >= VER_WIN2000;
end;

function IsWin9x: Boolean;
begin
  Result := GetWindowsVersion and VER_WIN95 >= VER_WIN95;
end;

function IsWinNT: Boolean;
begin
  Result := GetWindowsVersion and VER_WINNT >= VER_WINNT;
end;

function IsWinNT4: Boolean;
begin
  Result := GetWindowsVersion and VER_WINNT4 >= VER_WINNT4;
end;