home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
OS/2 Shareware BBS: 10 Tools
/
10-Tools.zip
/
acl-lib.zip
/
ACLUtility.pas
< prev
next >
Wrap
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.