ProGestion/Base/uSysFunc.pas

{
===============================================================================
  Copyright (©) 2002. Rodax Software.
===============================================================================
  Los contenidos de este fichero son propiedad de Rodax Software titular del
  copyright. Este fichero sólo podrá ser copiado, distribuido y utilizado,
  en su totalidad o en parte, con el permiso escrito de Rodax Software, o de
  acuerdo con los términos y condiciones establecidas en el acuerdo/contrato
  bajo el que se suministra.
  -----------------------------------------------------------------------------
  Web:  www.rodax-software.com
===============================================================================
  Fecha primera versión: 01-11-2002
  Versión actual: 1.0.0
  Fecha versión actual: 01-11-2002
===============================================================================
  Modificaciones:

    Fecha         Comentarios
    ---------------------------------------------------------------------------
===============================================================================
}

unit uSysFunc;

interface

{ Funciones del sistema }
function Ejecutar (const LineaComando: String; Oculto, Esperar: Boolean) : Boolean;
function DarRutaTemporal : String;
function DarFicheroTemporal : String;
function DarFicheroBMPTemporal : String;
function DarFicheroTIFFTemporal : String;
function DarFicheroExportar (var Fichero : String) : Boolean;
function DarVersionFichero (Executable : String) : String;
function DarFechaFichero (Executable : String) : String;
procedure CopiarFichero(const Origen, Destino: string);
procedure DoDelTree( TheDir : String);
procedure Deltree(DirToKill : String; KillChoosenDir : Boolean);


implementation

uses
  SysUtils, Windows, Dialogs,

  Messages, Classes, Graphics, Controls, Forms, 
  StdCtrls;

function Ejecutar (const LineaComando: String; Oculto, Esperar: Boolean): Boolean;
var
   StartupInfo : TStartupInfo;
   ProcessInfo : TProcessInformation;
begin
  {setup the startup information for the application }
  FillChar(StartupInfo, SizeOf(TStartupInfo), 0);
  with StartupInfo do
  begin
    cb := SizeOf(TStartupInfo);
    dwFlags:= STARTF_USESHOWWINDOW or STARTF_FORCEONFEEDBACK;
    if Oculto then
      wShowWindow:= SW_HIDE
    else
      wShowWindow:= SW_SHOWNORMAL;
  end;

  Result := CreateProcess(nil,PChar(LineaComando), nil, nil, False,
                          NORMAL_PRIORITY_CLASS, nil, nil, StartupInfo, ProcessInfo);
  if Esperar then
    if Result then
    begin
      WaitForInputIdle(ProcessInfo.hProcess, INFINITE);
      WaitForSingleObject(ProcessInfo.hProcess, INFINITE);
    end;
end;

function DarRutaTemporal: String;
var
  nBufferLength : DWORD; // size, in characters, of the buffer
  lpBuffer      : PChar; // address of buffer for temp. path
begin
  nBufferLength := MAX_PATH + 1; // initialize
  GetMem( lpBuffer, nBufferLength );
  try
    if GetTempPath( nBufferLength, lpBuffer ) <> 0 then
      Result := StrPas( lpBuffer )
    else
      Result := '';
  finally
    FreeMem( lpBuffer );
  end;
end;

function DarFicheroTemporal : String;
var
  Buf: array [0..MAX_PATH] of Char;
  RutaTmp : string;
begin
  RutaTmp := DarRutaTemporal;
  if GetTempFileName(PChar(RutaTmp), 'tmp', 0, Buf) <> 0 then
    SetString(Result, Buf, StrLen(Buf))
  else
    Result := '';
end;

function DarFicheroTIFFTemporal : String;
var
  Cadena : String;
begin
  Cadena := DarFicheroTemporal;
  Result := Copy(Cadena, 0, (Length(Cadena)-3)) + 'tif';
end;

function DarFicheroBMPTemporal : String;
var
  Cadena : String;
begin
  Cadena := DarFicheroTemporal;
  Result := Copy(Cadena, 0, (Length(Cadena)-3)) + 'bmp';
end;

function DarFicheroExportar (var Fichero : String) : Boolean;
var
  DialogoSalvar : TSaveDialog;
begin
  Result := False;
  DialogoSalvar := TSaveDialog.Create(NIL);
  try
    with DialogoSalvar do
    begin
      DefaultExt := 'doc';
      Filter := 'Documento de Word (*.doc)|*.doc';
      FilterIndex := 0;
      Options := [ofOverwritePrompt, ofHideReadOnly, ofPathMustExist, ofEnableSizing];
    end;
    Result := DialogoSalvar.Execute;
    if Result then
      Fichero := DialogoSalvar.FileName;
  finally
    DialogoSalvar.Free;
  end;
end;

function DarVersionFichero (Executable : String) : String;
var
  Size, Size2: DWord;
  Pt, Pt2: Pointer;
begin
 Size := GetFileVersionInfoSize(PChar (Executable), Size2);
 if Size > 0 then
 begin
   GetMem (Pt, Size);
   try
      GetFileVersionInfo (PChar (Executable), 0, Size, Pt);
      VerQueryValue (Pt, '\', Pt2, Size2);
      with TVSFixedFileInfo (Pt2^) do
      begin
        Result:= IntToStr (HiWord (dwFileVersionMS)) + '.' +
                 IntToStr (LoWord (dwFileVersionMS)) + '.' +
                 IntToStr (HiWord (dwFileVersionLS)) + '.' +
                 IntToStr (LoWord (dwFileVersionLS));
     end;
   finally
     FreeMem (Pt);
   end;
 end;
end;

function DarFechaFichero (Executable : String) : String;
var
   FileTime, LocalFileTime : TFileTime;
   SystemTime : TSystemTime;
   hFile  : Integer;
begin
   hFile := FileOpen(Executable, fmShareDenyNone);
   try
      if hFile <> -1 then
      begin
        Windows.GetFileTime( hFile, nil, nil, @FileTime ); // ftLasWriteTime
         // Change the file time to local time
         FileTimeToLocalFileTime( FileTime, LocalFileTime );
         if FileTimeToSystemTime(LocalFileTime, SystemTime) then
          Result := DateTimeToStr(SystemTimeToDateTime(SystemTime));
      end; // if hFile <> 0
   finally
      FileClose( hFile );
   end; // try
end;


procedure CopiarFichero(const Origen, Destino: string);
var
  lpMsgBuf : pchar;
begin
  CopyFile(PChar(Origen), PChar(Destino), FALSE);
end;

procedure DoDelTree(TheDir : String);
 Var
  Search : TSearchRec;
  rec    : word;
Begin
  If TheDir[Length(TheDir)] <> '\' Then TheDir := TheDir + '\';
   rec := SysUtils.FindFirst(TheDir + '*.*', faAnyFile, Search);
  While rec = 0 Do
   Begin
    If Search.Name[1] <> '.' Then
     Begin
// Is this a directory?
      If (Search.Attr And faDirectory) = faDirectory Then
       Begin
// If so, lets call DelTree again using this new
// directory as the TheDir parameter.
        DoDelTree(TheDir + Search.Name);
// Not that all of the files are gone from this directoy,
// we can remove the directory.
        RmDir(TheDir + Search.Name);
       End
       Else
       Begin
// We found a file.
// Now lets reset its attributes so we don't have any problems
// deleting them.
        SysUtils.FileSetAttr(TheDir + Search.Name, 0);
        SysUtils.DeleteFile(TheDir + Search.Name);
        Application.ProcessMessages;
       End;
     End;
    rec := SysUtils.FindNext(Search);
   End;
  SysUtils.FindClose(Search);
End;

procedure Deltree(DirToKill : String; KillChoosenDir : Boolean);
begin
{$I-}
 DoDelTree(DirToKill);
// If we want to delete the choosen directory.
 If KillChoosenDir Then
 RmDir(DirToKill);
 //modified
  if IOResult <> 0 then
  ShowMessage('Could not delete ' + DirToKill);
//{$I}
end;


end.