root/trunk/MyUtils.pas

unit MyUtils;

interface

uses classes,SysUtils;


{ True if a string is only whitespace or less }
function Empty( S:string ): boolean;

{ True if a file or directory exists }
function PathExists( P : string ) : boolean;

{ Copies a list, caller should Free the list }
function CopyList( list : TStringList ) : TStringList;

{ Joins a list of strings using the passed delimiter }
function Join( strings: TStringList ; delim : string ): string;

{ Attempts to parse an Integer into a var, true on success }
function ParseInt( S : string ; var N : LongInt ) : boolean;

{ Extracts a token from the String and returns it }
function Tokenize( var S : string ; const delim : string ) : string ;

{ Splits a string into 1+ parts using delimiter passed }
procedure Split( S, delim : string ; dest : TStringList );

{ Strips all characters from S which are in  sub }
function StripAll( S, chars : string ) : string ;

{ Finds the first position in S of any of the characters in chars }
function Find( S, chars : string; N : Integer ) : LongInt; overload;
function Find( S, chars : string ): LongInt ; overload;

{ Trims all strings from list, Removes empty strings ones }
procedure TrimAll( list : TStringList );

{ Converts a Path or a Filename into its Short counterpart, works with non-existing files }
function ShortPath( dir : string ) : string ; overload ;
function ShortName( fname : string ) : string ; overload;

{ Converts a list of Paths or list of names into short form }
procedure GetShortPaths( files: TStringList );
procedure GetShortNames( files: TStringList );


{ Convert to relative path, if possible, else return the original }
function RelativePath( base, path : string ) : string;

{ Convert to full path, using base path unless it is already a full path }
function FullPath( base, fname : string ) : string ;

// Expand any relative pathnames into full pathnames using base
procedure ConvertToFullNames( list : TStringList ; base : string );

// shorten full pathnames into ones relative to the base dir
procedure ConvertToRelativeNames( list : TStringList ; base: string );


{ General cleanup functions for Paths and Filenames }
function Path( dir : string ): string; overload;
function Path( dir, name : string ) : string; overload;

{ Call an external program, ConsoleApp captures the output of the invoked prog }
function Win32Exec( prog, args : string ) : LongWord ;
procedure ConsoleApp( prog, args: string; output :TStringList  );



implementation

uses Windows, FileCtrl;

var
  ignored : TStringList;

  
// Call and forget Function
function Win32Exec( prog, args : string ) : LongWord ;
var
  cmdline : string;
  pi: TProcessInformation;
  si: TStartupInfo;
begin
  FillMemory( @si, sizeof( si ), 0 );
  si.cb := sizeof( si );

  cmdline := prog + ' ' + args;

  CreateProcess( Nil, PChar( cmdline ),
    Nil, Nil, False,
    NORMAL_PRIORITY_CLASS, Nil, Nil, si, pi );

  WaitForSingleObject(PI.hProcess, 1000);  
  GetExitCodeProcess(PI.hProcess, Result);
  CloseHandle( pi.hProcess );
  CloseHandle( pi.hThread );
end;


// Call and Capture Function
procedure ConsoleApp( prog, args: string; output :TStringList  );
const
     LENBUFF = 4096;
     LF  = Char($D);
     CR  = Char($A);
var
   delim : string;
   commandline : string;
   hReadPipe, hWritePipe: THandle;
   sa : TSecurityAttributes;
   si : TStartupInfo;
   pi : TProcessInformation;
   lpBuffer    : array[0..LENBUFF] of char;
   Bytes, MaxBytes : DWord;
   Buffer      : string;
begin
     ZeroMemory( @sa, Sizeof(SA) );
     sa.nLength              := sizeof( sa );
     sa.lpSecurityDescriptor := nil;
     sa.bInheritHandle       := True;

     if not CreatePipe( hReadPipe, hWritePipe, @sa, 0 ) then begin
        MessageBox( 0, pChar('Error creation Pipe' ), 'Error',IDOK );
        exit;
     end;

     SetHandleInformation(hReadPipe, HANDLE_FLAG_INHERIT, 0);

     FillChar( si, sizeof(si), 0 );
     si.cb          := sizeof( si );
     si.dwFlags     := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
     si.wShowWindow := SW_HIDE;
     si.hStdInput   := 0;
     si.hStdOutput  := hWritePipe;
     si.hStdError   := hWritePipe;

     commandline := prog + ' ' + args ;

     if not CreateProcess( nil, pChar( commandline ), nil, nil, true,
                           CREATE_NO_WINDOW, nil, nil, si, pi ) then
     begin
        MessageBox( 0, pChar('Error executing command' ), 'Error', IDOK );
        CloseHandle( hReadPipe );
        CloseHandle( hWritePipe );
        exit;
     end;

     CloseHandle(pi.hThread);
     CloseHandle( hWritePipe );
     MaxBytes := LENBUFF;
     Bytes := 0;
     Buffer := '';
     SetLength( delim, 2 );
     delim[1] := LF;
     delim[2] := CR;
     While ReadFile( hReadPipe, lpbuffer, MaxBytes, Bytes, nil ) do
     begin
       if ( Bytes = 0 ) then break;
       Buffer := Buffer + Copy(lpBuffer, 1, Bytes);
       ZeroMemory( @lpBuffer, Sizeof(lpBuffer) );
     end;
     Split( Buffer, delim , output );

     WaitForSingleObject( pi.hProcess, 5000 );
     CloseHandle( pi.hProcess );
     CloseHandle( hReadPipe );
end;


{ Fix up a path name }
function Path( dir : string ): string;
var
   tmp : string;
begin
  tmp := StringReplace( dir, '/', '\', [rfReplaceAll]);
  tmp := Trim( tmp );
  while Pos( '\\', tmp )>0 do
    tmp:= StringReplace( tmp, '\\', '\', [rfReplaceAll] );

  while Length(tmp)>0 do
    if tmp[1]='\' then tmp:= Copy( tmp, 2, Length(tmp)-1 ) else Break;
    
  result := tmp;
end;


function Path( dir, name : string ) : string;
begin
  result := Path( dir + '\' + name );
end;


{ True if a file or directory exists }
function PathExists( P : string ) : boolean;
begin
  result:= FileExists( P ) or DirectoryExists( P );
end;

{ Unlike the built in function, this one will handle files which dont exist}
function ShortName( fname : string ) : string ;
var
   f,p : string;
begin
   f := ExtractFileName( fname );
   p := ExtractFilePath( fname );
   result:= Path( ShortPath( p ) , f ) ;
end;



function ShortPath( dir : string ) : string ;
begin
   result:= '';
   if not DirectoryExists( dir ) then Exit;
   dir := Trim(dir) ;
   if Pos( ' ', dir )>0 then dir := ExtractShortPathName( dir );
   dir := Path( dir );
   result := Path( dir, '' );
end;


{ Convert a list of directories to short names }
procedure GetShortPaths( files: TStringList );
var
   N : Integer;
begin
   if not Assigned(files) then Exit;
   for N:=0 to files.Count-1 do
   begin
     files[N] := ShortPath( files[N] );
   end;
end;


{ Convert a list of filenames to short name paths }
procedure GetShortNames( files: TStringList );
var
   N : Integer;
begin
   if not Assigned(files) then Exit;
   for N:=0 to files.Count-1 do
   begin
     files[N] := ShortName( files[N] );
   end;
end;



// Expand any relative pathnames into full pathnames using base
procedure ConvertToFullNames( list : TStringList ; base : string );
var
   N : Integer;
   parent, p : string;
begin
  if FileExists( base )
  then parent := ExtractFilePath( base )
  else parent := base;

  for N:=0 to list.Count-1 do begin
    p:= list[N];
    if PathExists( p ) then Continue;
    p:= FullPath( parent, p );
    if not PathExists( p ) then Continue;
    list[N]:= p;
  end;
end;


{ Convert to relative path, if possible, else return the original }
function RelativePath( base, path : string ) : string;
begin
  result:= ExtractRelativePath( base, path );
  if PathExists( result ) then Exit;
  result:= path;
end;


{ Convert to full path, using base path unless it is already a full path }
function FullPath( base, fname : string ) : string ;
var
  dir : string;
  A,B : Integer;
begin
  result:= fname;
  if Pos( '..', result )>0 then
  begin
    dir := Path( base, result );
    A:= Pos( '..', dir );
    B:=A + 2;
    Dec(A,2); // skip the '\'
    while (A>0) do begin
      if dir[A] = '\' then Break;
      Dec(A);
    end;

    if A>0 then result:=Copy( dir, 1, A );
    if B<Length(dir) then result:= result + Copy( dir, B, Length(dir)-B+1 );
    result:= Path( result );
  end
  else
  begin
    dir := Path( base, result );
    if PathExists( dir ) then result:= dir;
  end;
end; 


// shorten full pathnames into ones relative to the base dir
procedure ConvertToRelativeNames( list : TStringList ; base: string );
var
   N : Integer;
   p, rel : string;
   parent : string;
begin
  if FileExists( base ) then parent := ExtractFilePath( base )
  else parent := base;

   for N:=0 to list.Count-1 do begin
     p:= list[N];

     if not FileExists( p ) then Continue; // dont touch missing files
     rel := ExtractRelativePath( parent, p );
     if not Empty( rel ) then list[N]:= rel;
   end;
end;


procedure TrimAll( list : TStringList );
var N : integer;
    S : string;
begin
  N:=list.Count-1;
  while N>=0 do begin
    S := Trim( list[N] );
    if Length(S)<1 then list.Delete( N )
    else list[N] := S;
    Dec( N );
  end;
end;



function Find( S, chars : string ): LongInt ;
begin
  result:= Find( S, chars, 1 );
end;


{ find position of any characters from <chars> starting at index specified }
function Find( S, chars  : string; N : Integer ) : LongInt;
var
  P : Integer;
begin
  Result:= -1;
  if N< 1 then N := 1;
  if N > Length(S) then Exit;
  for P:=N to Length(S) do
    if Pos( S[P], chars ) > 0 then
    begin
      Result:= P;
      Exit;
    end;
end;



function StripAll( S, chars : string ) : string ;
var
  N, sz : Integer;
begin
  sz := Length( chars );
  Result := S;
  if sz < 1 then Exit;
  Result := '';
  for N:= 1 to Length( S ) do
  begin
    if Pos( S[N],chars )>0 then Continue;
    result := result + S[N];
  end;
end;

function Empty( S:string ): boolean;
begin
  Result:= ( Length( Trim(S) ) = 0 );
end;

function CopyList( list : TStringList ) : TStringList;
begin
  result := TStringList.Create;
  if assigned(list ) then result.AddStrings( list );
end;

function ParseInt( S : string ; var N : LongInt ) : boolean;
begin
  Result:= false;
  if Empty(S) then Exit;
  try begin
    N := StrToInt( S );
    Result:=true;
    end
  except Result:=false; end;
end;


function Skip( S, delim : string ) : string;
begin
  result:= S;
  while Length( result )>0 do
    if Pos( result[1], delim )>0 then
      result:= Copy( result, 2, Length(result)-1)
    else Break;
end;


function Tokenize( var S : string ; const delim : string ) : string ;
var
  N : Integer;
begin
  S:= Skip( S, delim );
  result := '';
  if Length(S)<1 then Exit;
  N := Find( S, delim, 1 );
  if N<1 then
  begin
    result:= S;
    S:= ''
  end
  else
  begin
    result:= Copy( S, 1, N-1 );
    S:= Copy( S, N, Length(S)-N );
  end;
end;


procedure Split( S, delim : string ; dest : TStringList );
var
   tok : String;
begin
  while Length(S)>0 do
  begin
   tok := Tokenize( S, delim );
   if Length(tok)>0 then dest.Add( tok );
  end;
end;


{ Split using any of the characters in delim 
procedure Tokenize( S, delim : string ; dest : TStringList );
var
   N, L : Integer;
   tok : string;
begin
   L:=Length( S );
   N:=1;
   while N<Length(S) do
   begin
     while (N<L) and (Pos( S[N] , delim )>0) do N:= N+1;
   end;
end;
}


{ Join a list of strings into one long string }
function Join( strings: TStringList ; delim : string ): string;
var
  E, str: string;
  N : Integer;
begin
  Result:= '';
  if not Assigned(strings) then Exit;
  str := '';
  for N:=0 to strings.Count-1 do begin
    E := Trim(strings[N]);
    if N > 0 then str := str + delim;
    str := str + E;
  end;
  Result := str;
end;




initialization
  ignored := TStringList.Create;

finalization
  ignored.Free;



end.