File:  [mozdev] / mozptch / linux_func.pas
Revision 1.1: download - view: text, annotated - select for diffs - revision graph
Sun May 30 19:51:15 2004 UTC (15 years, 5 months ago) by oertel
Branches: MAIN
CVS tags: version_30_05_04, HEAD
-Linux support ready for delivery (beta)
-New Variables for EmailAddress, ncoming and outgoing server
-INI-Files debuged
- new bin zip file

unit linux_func;

interface
{$IFDEF LINUX}
uses
SysUtils, Classes;

Type
  TcpSpecify = Byte;


Const
  (* additive Konstanten für den Typ TcpSpecify *)
  cpFlat                       = 0;  (* keine Rekursion und keine Subdirectories,
                                      unbegrenztes OverWrite *)
  cpCreateEmptySubdirectories  = 1;
  cpRecursive                  = 2;
  cpVersionControl             = 4;  (* Overwrite bei Dateien mit Extension in ExtensionsForVersionsControl
                                      nur nach vorheriger Versionskontrolle *)
  cpDateControl                = 8;  (* kein Overwrite bei Dateien mit Extension EXE wenn Zieldatei jüngeren Datums *)
  cpUpdate                     = 16; (* kein Overwrite, wenn Zieldatei jünger oder gleich alt *)
  cpNoOverwrite                = 32; (* kein Overwrite *)
  cpExtractLHA                 = 64; (* beim Kopieren Lharc-komprimierte Dateien dekomprimieren *)


function ValueOfEnvVar (Const VarName : String) : String;

Function FileCopy
      (Const sourcefilename, targetfilename: String;
       preserveDate, preserveAttr : boolean;
       Var problem : string)
      : Boolean;

Function AllCopy
(const SourceMask, Target: String; cpSpecify : TcpSpecify;
 preserveDate, preserveAttr : boolean;
 var MainFehler : string): Boolean;


{$ENDIF}
implementation
{$IFDEF LINUX}

function ValueOfEnvVar (Const VarName : String) : String;
begin
 ValueOfEnvVar := GetEnvironmentVariable(VarName)
end;

Function FileCopy
      (Const sourcefilename, targetfilename: String;
       preserveDate, preserveAttr : boolean;
       Var problem : string)
      : Boolean;
var
  NewFile: TFileStream;  OldFile: TFileStream;
begin
 FileCopy := false;
 OldFile := TFileStream.Create(sourcefilename, fmOpenRead or fmShareDenyWrite);
 try
  NewFile := TFileStream.Create(targetfilename, fmCreate or fmShareExclusive);
  try
   NewFile.CopyFrom(OldFile, OldFile.Size);
   FileCopy := true;
  finally
   FreeAndNil(NewFile);
  end;
 finally
  FreeAndNil(OldFile);
 end;
end;

Function FileCheckDate
         (Const Sourcefilename, Targetfilename: String; OverwriteIfEqual: Boolean) : Boolean;
 (* Assumption: Both files exist *)
  Var
   Handle : Integer;
   Date1, Date2 : LongInt;

begin
  Handle := fileopen (Sourcefilename, fmOpenRead);
  Date1 := filegetdate (Handle);
  fileclose (handle);
  Handle := fileopen (Targetfilename, fmOpenRead);
  Date2 := filegetdate (Handle);
  fileclose (handle);
  if (Date2 < Date1) or ((Date2 = Date1) and OverwriteIfEqual)
  then
  Begin
    Result := true;
  End
  else
  Begin
    Result := false;
  End
end;


Function AllCopy
(const SourceMask, Target: String; cpSpecify : TcpSpecify;
 preserveDate, preserveAttr : boolean;
 var MainFehler : string): Boolean;
Var
  FileFound : Boolean;
  Recursion_Level : Integer;
  TeilFehler : string;


  Procedure AllCopyRecursive
  (var Recursion_Level : Integer; SourceMask, Target: String;
//   preserveDate, preserveAttr : boolean;
   Var FileFound : Boolean; var cpSpecify : TcpSpecify);

  Var
    CompleteName, Extension,
    SourcePath, SourceFilemask, SourceName,
    TargetPath, TargetFilemask, TargetName: String;

    FindResultcode: Integer;
    FileAttr : Integer;
    SearchResult : TSearchRec;

    FileFoundOnThisLevel, FileFoundOnADeeperLevel: Boolean;
    DirectoryExisted : Boolean;
    DirectoryError : Integer;


    Procedure ToCopyOrNotToCopy (Const SourceName, TargetName : String);
    var
        CopyShallTakePlace : Boolean;
    Begin //ToCopyOrNotToCopy
     if SourceName = TargetName
     then
     begin
     end
     else
     begin
      CopyShallTakePlace := true;

  (*      if cpSpecify and cpVersionControl = cpVersionControl
       then
       Begin
         Extension := UpperCase (ExtractFileExt (TargetName));
         delete (Extension, 1, 1);
         if StrIsIn (Extension, ExtensionsForVersionControl) > 0
         then
         CopyShallTakePlace := FileCheckVersions (SourceName, TargetName);
       End; *)

      if CopyShallTakePlace and FileExists (TargetName) then
      begin
       if cpSpecify and cpNoOverwrite = cpNoOverwrite
       then
       Begin
        CopyShallTakePlace := false;
       End
       else if cpSpecify and cpUpdate = cpUpdate
       then
       Begin
         CopyShallTakePlace := FileCheckDate (SourceName, TargetName, false)
       End
       else if cpSpecify and cpDateControl = cpDateControl
       then
       Begin
         Extension := UpperCase (ExtractFileExt (TargetName));
         delete (Extension,1,1);
         if (Extension = 'EXE')
         then
         CopyShallTakePlace := FileCheckDate (SourceName, TargetName, true)
       End
       else
       begin
       end;
      End;

      if CopyShallTakePlace
      then
      begin
       if FileCopy (SourceName, TargetName, preserveDate,
                     preserveAttr, TeilFehler)  then
       else
       begin
        MainFehler := MainFehler + TeilFehler;
        result := false;
       end;
      end;
     end;
    End; //ToCopyOrNotToCopy


  Begin //AllCopyRecursive
    Recursion_Level := Recursion_Level + 1;
    FileFoundOnThisLevel := false;

    (* SourceMask auf Standardform bringen *)

    CompleteName := ExpandFileName (SourceMask);
    SourcePath := ExtractFilePath (CompleteName);
    if SourcePath [length (SourcePath)] <> '\' then
       SourcePath := SourcePath + '\';
    SourceFilemask := ExtractFileName (CompleteName);
    if SourceFilemask = '' then SourceFilemask := '*.*';

    (* TargetMask auf Standardform bringen *)
    CompleteName := ExpandFileName (Target);
    TargetPath   := CompleteName;
    if TargetPath [length (TargetPath)] <> '\' then
       TargetPath := TargetPath + '\';


    if (length (TargetPath) > 1) and (TargetPath [length (TargetPath) - 1] = ':')
    then
      (* TargetPath is e.g. c:\, that is, not a file but a volume identifier *)
    else
    Begin
      CompleteName := copy (TargetPath, 1, length (TargetPath) - 1);

      if DirectoryExists (CompleteName)
      then
      begin
        exit;
      end;
    End;

    FindResultcode
    := FindFirst (SourcePath + SourceFilemask, faAnyfile - faDirectory, // - faVolumeId,
                  SearchResult);

    if FindResultcode = 0
    then FileFoundOnThisLevel := true
    else
    Begin
    End;

    while FindResultcode = 0
    do
    Begin
      SourceName := SourcePath + SearchResult.Name;
      TargetName := TargetPath + SearchResult.Name;


      ToCopyOrNotToCopy (SourceName, TargetName);

      FindResultcode := FindNext (SearchResult);
    end;

   FindClose (SearchResult);

   (* Subdirectories im Source-Verzeichnis suchen
     und gegebenenfalls im Targetverzeichnis neu anlegen *)

    FindResultcode
    := FindFirst (SourcePath + '*.*', faDirectory(* faAnyFile *),
                  SearchResult);


    while FindResultcode = 0
    do
    Begin
      if (SearchResult.Attr and faDirectory = faDirectory) and
         (SearchResult.Name <> '.') and
         (SearchResult.Name <> '..')
      then
      Begin
        DirectoryError := 0;

        TargetName := TargetPath + SearchResult.Name;
        if FileExists(TargetName) then
        begin
         DirectoryError := 1;
        end
        else
        begin
         if DirectoryExists(TargetName) then
         begin
          DirectoryExisted := true;
         end
         else
         begin
          DirectoryExisted := false;
          try
           mkdir (TargetName);
          except
           DirectoryError := 2;
          end;
         end;
        end;
        (*
        FileAttr := FileGetAttr (TargetName);

        if (FileAttr >= 0)
        then
        Begin

          if FileAttr = faDirectory
          then
          Begin
            DirectoryExisted := true;
          End
          else
          Begin
            DirectoryError := 1;
          End
        end
        else
        begin
          DirectoryExisted := false;
          try
            mkdir (TargetName);
          except
            DirectoryError := 2;
          end;

        end;
        *)
        FileFoundOnADeeperLevel := false;

        if ((cpSpecify and cpRecursive) = cpRecursive)
            and (DirectoryError = 0)
        then
          (* Rekursion *)
        Begin

          AllCopyRecursive
          (Recursion_Level, SourcePath + SearchResult.Name + '\'+ SourceFileMask,
           TargetName, FileFoundOnADeeperLevel, cpSpecify);
          if FileFoundOnADeeperLevel then FileFoundOnThisLevel := true;

        End;

        if ((cpSpecify and cpCreateEmptySubdirectories) = 0)
            and not FileFoundOnADeeperLevel and not DirectoryExisted
            and (DirectoryError = 0)
        then
          (* angelegtes directory wieder entfernen *)
          rmdir (TargetName);


      end;

      FindResultcode := FindNext (SearchResult);
    end;

    FindClose (SearchResult);

    FileFound := FileFoundOnThisLevel (* resp. on a deeper level *);
    Recursion_Level := Recursion_Level - 1;
  End; //AllCopyRecursive

Begin

  result := true;
  MainFehler := '';
  TeilFehler := '';
  FileFound := false;
  Recursion_Level := -1;


  AllCopyRecursive
      (Recursion_Level, SourceMask, Target, FileFound, cpSpecify);

End;
(*
begin
// to be implemented
end;
*)

{$ENDIF}
end.

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>