OS/2 Shareware BBS: 10 Tools/10-Tools.zip/acl-lib.zip/ACLUtility.pas

Pascal/Delphi Source File | 2000-07-19 | 7KB | 283 lines

Unit ACLUtility;

Interface

Uses
  Classes, SysUtils, Forms, StdCtrls;

Type
  TPrintOutput = procedure( TheText: string ) of object;
  TTerminateCheck = function: boolean of object;
  TProgressCallback = procedure( n, outof: integer;
                                 Message: string ) of object;

const
   _MAX_PATH = 260;    /* max. length of full pathname           */
   _MAX_DRIVE = 3;     /* max. length of drive component         */
   _MAX_DIR = 256;     /* max. length of path component          */
   _MAX_FNAME = 256;   /* max. length of file name component     */
   _MAX_EXT = 256;     /* max. length of extension component     */

Procedure MergeStringLists( Dest: TStringList;
                            AdditionalList: TStringList );

procedure MemCopy( const Source, Dest: pointer; const Size: longint );

procedure FillMem( Dest: pointer;
                   Size: longint;
                   Data: Byte );

function Min( a, b: longint ): longint;

Procedure AssignList( Source, Dest: TList );

// Reverse the given list. It must be set to not sorted
Procedure ReverseList( TheList: TStrings );

// Sort the given list into reverse alphabetical order
//Procedure ReverseSortList( TheList: TStringList );

// Find the given string in the given list, using
// case insensitive searching (and trimming)
// returns -1 if not found
Function FindString( TheString: string; TheList:TStrings ):longint;

Function SearchPath( PathEnvVar: string;
                     Filename: string;
                     Var FilenameFound: string ): boolean;

Function RunProgram( FileName: string;
                     Parameters: string ): boolean;

{$ifdef win32}
type
  TDaylightSavingStatus =
  (
    dssDisabled,
    dssDaylightSaving,
    dssNormal
  );

function GetDaylightSavingStatus: TDaylightSavingStatus;
{$endif}

Implementation

Uses
{$ifdef os2}
  Dos, BseDos, Os2Def,
{$else}
  Windows, FileCtrl,
{$endif}
  ACLStringUtility, Dialogs,
  ACLFindFunctions;

function Min( a, b: longint ): longint;
begin
  if a<b then
   result:= a
  else
   result:= b;
end;

Procedure MergeStringLists( Dest: TStringList;
                            AdditionalList: TStringList );
var
  i: integer;
  s: string;
begin
  for i:= 0 to AdditionalList.Count - 1 do
  begin
    s:= AdditionalList[ i ];
    if FindString( s, Dest ) = -1 then
      Dest.AddObject( s, AdditionalList.Objects[ i ] );
  end;
end;

procedure MemCopy( const Source, Dest: pointer; const Size: longint );
begin
  Move( Source^, Dest^, Size );
end;

procedure FillMem( Dest: pointer;
                   Size: longint;
                   Data: Byte );
begin
  FillChar( Dest^, Size, Data );
{  while Size > 0 do
  begin
    PBYTE( Dest )^:= Data;
    inc( Dest );
    dec( Size );
  end;}
end;

Procedure AssignList( Source, Dest: TList );
var
  i: longint;
begin
  Dest.Clear;
  for i:= 0 to Source.Count - 1 do
    Dest.Add( Source[ i ] );
end;

{$ifdef os2}

Function SearchPath( PathEnvVar: string;
                     Filename: string;
                     Var FilenameFound: string ): boolean;
var
  szEnvVar: cstring;
  szFilename: cstring;
  szFilenameFound: cstring;
  rc: APIRET;
begin
  Result:= false;
  FilenameFound:= '';

  szEnvVar:= PathEnvVar;
  szFilename:= Filename;
  rc:= DosSearchPath( SEARCH_IGNORENETERRS
                      + SEARCH_ENVIRONMENT
                      + SEARCH_CUR_DIRECTORY,
                      szEnvVar,
                      szFilename,
                      szFilenameFound,
                      sizeof( szFilenameFound ) );

  if rc = 0 then
  begin
    Result:= true;
    FilenameFound:= szFilenameFound;
  end
end;

Function RunProgram( FileName: string;
                     Parameters: string ): boolean;
var
  Dir: string;
  Found: boolean;
  Dummy: string;
  rc: longint;
  Extension: string;
begin
  Dir:= ExtractFilePath( FileName );
  if Dir = '' then
    Found:= SearchPath( 'PATH',
                        Filename,
                        Dummy )
  else
    // file path specified...
    Found:= FileExists( FileName );

  if not Found then
  begin
    Result:= false;
    exit;
  end;

  Result:= true;

  Extension:= ExtractFileExt( FileName );
  if StringsSame( Extension, '.exe' ) then
    Exec( FileName,
          Parameters )
  else
    Exec( 'cmd.exe',
          '/c '
          + FileName
          + ' '
          + Parameters );

end;
{$else}
Function RunProgram( FileName: string;
                     Parameters: string ): boolean;
Var
  StartupInfo: TStartupInfo;
  ProcessInfo: TProcessInformation;
  NameAndArgs: string;
Begin
  NameAndArgs:= FileName+' '+Parameters;

  // Initialize some variables to create a process
  ZeroMemory( @StartupInfo, SizeOf( StartupInfo ) );

  StartupInfo.cb := SizeOf( StartupInfo );
  StartupInfo.dwFlags := STARTF_USESTDHANDLES;

  // Create the process
  Result:= CreateProcess( Nil, // use next param for exe name
                          PChar( NameAndArgs ), // command line
                          Nil, // no security attributes
                          Nil, // no thread security attributes
                          True, // do inherit handles
                          CREATE_NEW_PROCESS_GROUP, // so we can send
                          // it Ctrl signals
                          Nil, // no new environment
                          Nil, // use current directory
                          StartupInfo,
                          ProcessInfo );
  if not Result then
    exit;

end;
{$endif}

Procedure ReverseList( TheList:TStrings );
Var
  TempList: TStringList;
  i: integer;
Begin
  TempList:= TStringList.Create;
  for i:=TheList.count-1 downto 0 do
  begin
    TempList.AddObject( TheList.Strings[i],
                        TheList.Objects[i] );
  end;
  TheList.Assign( TempList );
  TempList.Destroy;
end;

Procedure ReverseSortList( TheList: TStringList );
Begin
  TheList.Sort;
  ReverseList( TheList );
end;

Function FindString( TheString: string; TheList:TStrings ):longint;
Var
  i: longint;
Begin
  for i:=0 to TheList.count-1 do
  begin
    if StringsSame( TheString, TheList[ i ] ) then
    begin
      // found
      Result:=i;
      exit;
    end;
  end;
  Result:=-1;
End;

{$ifdef win32}
function GetDaylightSavingStatus: TDaylightSavingStatus;
var
  TimeZoneInfo: TIME_ZONE_INFORMATION;
  ZoneID: DWORD;
Begin
  ZoneID:= GetTimeZoneInformation( TimeZoneInfo );
  if TimeZoneInfo.DaylightBias = 0 then
    Result:= dssDisabled
  else if ZoneID = TIME_ZONE_ID_DAYLIGHT then
    Result:= dssDaylightSaving
  else
    Result:= dssNormal;
end;
{$endif}

Initialization
End.