EldoS | Feel safer!

Software components for data protection, secure storage and transfer

Install app CallbackFilter in other PC

Also by EldoS: SecureBlackbox
200+ components and classes for digital security, signing, encryption and secure networking.
#9778
Posted: 04/22/2009 15:41:24
by Rodolfo Burlando (Basic support level)
Joined: 04/22/2009
Posts: 3

Hi.

The test application works very well on my pc.
But when running the application on another PC, it hangs, as if the driver was not installed properly.

Check the file in regedit and windows/system32/driver and I think this correct. That may be missing?

Ah

Only works where it is installed on the PC CallbackFilter development.

Best regards

Rodolfo Burlando
#9780
Posted: 04/23/2009 02:03:35
by Vladimir Cherniga (EldoS Corp.)

Hi,
could you specify what is the test application you mean - CBFilter, Filemon or Encrypt sample. Please explain in details under what conditions system hang. Are there any anti-virus software on the test machines ?
#9794
Posted: 04/24/2009 09:19:10
by Rodolfo Burlando (Basic support level)
Joined: 04/22/2009
Posts: 3

It is an application that uses CBFilter, the application only runs on the PC where you install the VCL (with Delphi).

When you install the compiled application on another PC (exe + sys) and run the application that I copied the folder windows/system32/drivers

Also note that new records were created in the Windows regedit.
It is also necessary to restart the PC.

But when you run the test application simply does not work. It crashed!.

Want to see the executable file or the source?.

I do the testing in virtual machines and virgin PC (without either componte Delphi VCL installed)

In other PCs NOD Antivirus and Avast Antivirus are warnings of possible Virus!.

Thank you very much.

Rodolfo Burlando
#9795
Posted: 04/24/2009 09:54:49
by Vladimir Cherniga (EldoS Corp.)

If I understood you correctly you built your own application based on the CBFilter Dephi sources ? And this application just crashes on another machine. Post here your sources so i can check it.
#9797
Posted: 04/24/2009 10:05:18
by Rodolfo Burlando (Basic support level)
Joined: 04/22/2009
Posts: 3

attachment source.

thank's.

Rodolfo Burlando

Code
unit und_main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, CbFlt, JvSimpleXml, IdBaseComponent, IdComponent, IdTCPConnection,
  IdTCPClient, und_Message, WinSvc, ExtCtrls, StdCtrls, ImgList, Menus,
  JvComponentBase, JvTrayIcon, JvMenus, und_CommServer, About, MSNPopUp,
  und_processFilter;

type
  Tfrm_main = class(TForm)
    cbfFilter: TCallbackFilter;
    TCPClient: TIdTCPClient;
    XML: TJvSimpleXML;
    Memo1: TMemo;
    Popup: TJvPopupMenu;
    TrayIcon: TJvTrayIcon;
    Detener1: TMenuItem;
    Acercade1: TMenuItem;
    ImageList1: TImageList;
    Reiniciar1: TMenuItem;
    Ocultar1: TMenuItem;
    Label1: TLabel;
    procedure FormActivate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormDestroy(Sender: TObject);
    procedure cbfFilterCanFileBeDeletedC(Sender: TObject; FileName: TCBString;
      var DeleteFile: Boolean; var UserContext: Pointer;
      var ProcessRequest: Boolean);
    procedure cbfFilterCloseFileC(Sender: TObject; FileName: TCBString;
      UserContext: Pointer);
    procedure cbfFilterCreateFileC(Sender: TObject; FileName: TCBString;
      var DesiredAccess: Cardinal; var FileAttributes, ShareMode: Word;
      var Options: Cardinal; var ProcessRequest: Boolean);
    procedure cbfFilterEnumerateDirectoryC(Sender: TObject; DirectoryName,
      FileName: TCBString; var CreationTime, LastAccessTime,
      LastWriteTime: TDateTime; var EndOfFile, AllocationSize, FileId: Int64;
      var FileAttributes: Cardinal; var UserContext,
      EnumerationContext: Pointer; var ProcessRequest: Boolean);
    procedure cbfFilterOpenFileC(Sender: TObject; FileName: TCBString;
      var DesiredAccess: Cardinal; var FileAttributes, ShareMode: Word;
      var Options: Cardinal; var ProcessRequest: Boolean);
    procedure cbfFilterPostCreateFileC(Sender: TObject; FileName: TCBString;
      DesiredAccess: Cardinal; FileAttributes, ShareMode: Word;
      Options: Cardinal; var UserContext: Pointer);
    procedure cbfFilterPostOpenFileC(Sender: TObject; FileName: TCBString;
      DesiredAccess: Cardinal; FileAttributes, ShareMode: Word;
      Options: Cardinal; var UserContext: Pointer);
    procedure cbfFilterRenameOrMoveFileC(Sender: TObject; FileName,
      NewFileName: TCBString; var UserContext: Pointer;
      var ProcessRequest: Boolean);
    procedure cbfFilterSetAllocationSizeC(Sender: TObject; FileName: TCBString;
      var AllocationSize: Int64; var UserContext: Pointer;
      var ProcessRequest: Boolean);
    procedure cbfFilterSetEndOfFileC(Sender: TObject; FileName: TCBString;
      var EndOfFile: Int64; var UserContext: Pointer;
      var ProcessRequest: Boolean);
    procedure cbfFilterSetFileAttributesC(Sender: TObject; FileName: TCBString;
      var CreationTime, LastAccessTime, LastWriteTime: TDateTime;
      var FileAttributes: Cardinal; var UserContext: Pointer;
      var ProcessRequest: Boolean);
    procedure cbfFilterReadFileC(Sender: TObject; FileName: TCBString;
      var Position: Int64; Buffer: PByte; var BytesToRead: Cardinal;
      var UserContext: Pointer; var ProcessRequest: Boolean);
    procedure cbfFilterPostReadFileC(Sender: TObject; FileName: TCBString;
      Position: Int64; Buffer: PByte; BytesToRead: Cardinal;
      var UserContext: Pointer; var ProcessRequest: Boolean);
    procedure cbfFilterWriteFileC(Sender: TObject; FileName: TCBString;
      var Position: Int64; Buffer: PByte; var BytesToWrite: Cardinal;
      var UserContext: Pointer; var ProcessRequest: Boolean);
    procedure cbfFilterPostWriteFileC(Sender: TObject; FileName: TCBString;
      Position: Int64; Buffer: PByte; BytesToWrite: Cardinal;
      var UserContext: Pointer; var ProcessRequest: Boolean);
    procedure cbfFilterSetFileSecurityC(Sender: TObject; FileName: TCBString;
      SecurityInformation: Cardinal; SecurityDescriptor: Pointer;
      Length: Cardinal; var ProcessRequest: Boolean);
    procedure FormCreate(Sender: TObject);
    procedure Detener1Click(Sender: TObject);
    procedure Acercade1Click(Sender: TObject);
    procedure Ocultar1Click(Sender: TObject);
    procedure Reiniciar1Click(Sender: TObject);
  private
    { Private declarations }
    filtrando:boolean;
    frm_acerca:TAboutBox;
    commServer: TCommServer;
    KeyFile:String;
    v_ServerIP: String;
    v_ServerPort: String;
    v_extBasica: String;

    function installDriver:boolean;
    procedure uninstallDriver;
    procedure Desconectar;
    procedure AskForReboot;
    procedure deleteFilter(Sender: TObject);
    procedure instalador;
    function GetWindowsDirectory : String;
    procedure Ocultar;
    procedure WMSysCommand(var Msg: TWMSysCommand); message WM_SYSCOMMAND;
  public
    { Public declarations }
    msnPopup: TMSNPopUp;
    cadenaFilfer: String;
    killThread:Boolean;   // una banderita para matar mas rapido a hilo
    function conectarTCP:boolean;
    procedure setFilter(archivo:String);
    procedure loadRegFilter;
    procedure addRegFilter(filtro:String);
    procedure delRegFilter(filtro:String);
  end;


const
  FProductID = '18189531-48ED-43fc-8582-E8BD2F9AB533';

var
  frm_main: Tfrm_main;

implementation

{$R *.dfm}

uses BootExec, Math;

type
  TEncryptContext = class
  private
    FFilter: TCallbackFilter;
    FHandle: THandle;
    FBufferSize: Cardinal;
    FBuffer: PAnsiChar;
    FCurrentSize: Int64;
    FRefCnt: Integer;
  public
    constructor Create(Filter: TCallbackFilter; FileName: TCBString);
    destructor Destroy; override;

    procedure Read(Position: Int64; Buffer: PByte; BytesToRead: Cardinal);
    procedure Write(Position: Int64; Buffer: PByte; BytesToWrite: Cardinal);
    procedure MoveFile(FileName, NewFileName: TCBString; Decrypt, Encrypt: Boolean);
    procedure EncryptBuffer;
    procedure DecryptBuffer;
    function IncrementRef: Integer;
    function DecrementRef: Integer;

    property CurrentSize: Int64 read FCurrentSize write FCurrentSize;
    property ReferenceCounter: Integer read FRefCnt write FRefCnt;
  end;

{ Tfrm_main }

procedure Tfrm_main.Acercade1Click(Sender: TObject);
begin
  // Llamamos al formulario de Acerca de ...
  frm_acerca.ShowModal;
end;

procedure Tfrm_main.Detener1Click(Sender: TObject);
var
  buttonSelected: integer;
begin
  // detenemos la aplicacion. salimos previo mensaje de advertencia.
  buttonSelected := MessageDlg('Deseas salir de la aplicación', mtConfirmation,
    mbOKCancel, 0);
  if buttonSelected = mrOK then Close;
end;

procedure Tfrm_main.AskForReboot;
begin
  if MessageDlg('Es necesario reiniciar el sistema con el fin de instalar los ' +
    'controladores. Reiniciar ahora?', mtConfirmation, [mbYes, mbNo], 0) = mrYes then
    InitiateSystemShutdown(nil, nil, 10000, false, true);
end;

procedure Tfrm_main.cbfFilterCanFileBeDeletedC(Sender: TObject;
  FileName: TCBString; var DeleteFile: Boolean; var UserContext: Pointer;
  var ProcessRequest: Boolean);
begin
  ProcessRequest := True;
end;

procedure Tfrm_main.cbfFilterCloseFileC(Sender: TObject; FileName: TCBString;
  UserContext: Pointer);
var
  Context: TEncryptContext;
begin
  Context := TEncryptContext(UserContext);
  if (Context <> nil) and (Context.DecrementRef = 0) then
    Context.Free;
end;

procedure Tfrm_main.cbfFilterCreateFileC(Sender: TObject; FileName: TCBString;
  var DesiredAccess: Cardinal; var FileAttributes, ShareMode: Word;
  var Options: Cardinal; var ProcessRequest: Boolean);
begin
  ProcessRequest := True;
end;

procedure Tfrm_main.cbfFilterEnumerateDirectoryC(Sender: TObject; DirectoryName,
  FileName: TCBString; var CreationTime, LastAccessTime,
  LastWriteTime: TDateTime; var EndOfFile, AllocationSize, FileId: Int64;
  var FileAttributes: Cardinal; var UserContext, EnumerationContext: Pointer;
  var ProcessRequest: Boolean);
begin
  ProcessRequest := True;
end;

procedure Tfrm_main.cbfFilterOpenFileC(Sender: TObject; FileName: TCBString;
  var DesiredAccess: Cardinal; var FileAttributes, ShareMode: Word;
  var Options: Cardinal; var ProcessRequest: Boolean);
begin
  ProcessRequest := True;
end;

procedure Tfrm_main.cbfFilterPostCreateFileC(Sender: TObject;
  FileName: TCBString; DesiredAccess: Cardinal; FileAttributes, ShareMode: Word;
  Options: Cardinal; var UserContext: Pointer);
var
  Context: TEncryptContext;
begin
  if UserContext = nil then
    begin
      Context := TEncryptContext.Create(cbfFilter, FileName);
      UserContext := Pointer(Context);
    end
  else
    begin
      Context := TEncryptContext(UserContext);
      Context.IncrementRef;
    end;
end;

procedure Tfrm_main.cbfFilterPostOpenFileC(Sender: TObject; FileName: TCBString;
  DesiredAccess: Cardinal; FileAttributes, ShareMode: Word; Options: Cardinal;
  var UserContext: Pointer);
var
  Context: TEncryptContext;
begin
  if UserContext = nil then
    begin
      Context := TEncryptContext.Create(cbfFilter, FileName);
      UserContext := Pointer(Context);
    end
  else
    begin
      Context := TEncryptContext(UserContext);
      Context.IncrementRef;
    end;
end;

procedure Tfrm_main.cbfFilterPostReadFileC(Sender: TObject; FileName: TCBString;
  Position: Int64; Buffer: PByte; BytesToRead: Cardinal;
  var UserContext: Pointer; var ProcessRequest: Boolean);
begin
  ProcessRequest := False;
end;

procedure Tfrm_main.cbfFilterPostWriteFileC(Sender: TObject;
  FileName: TCBString; Position: Int64; Buffer: PByte; BytesToWrite: Cardinal;
  var UserContext: Pointer; var ProcessRequest: Boolean);
begin
  ProcessRequest := False;
end;

procedure Tfrm_main.cbfFilterReadFileC(Sender: TObject; FileName: TCBString;
  var Position: Int64; Buffer: PByte; var BytesToRead: Cardinal;
  var UserContext: Pointer; var ProcessRequest: Boolean);
var
  Context: TEncryptContext;
begin
  Context := TEncryptContext(UserContext);
  Context.Read(Position, Buffer, BytesToRead);
  ProcessRequest := False;
end;

procedure Tfrm_main.cbfFilterRenameOrMoveFileC(Sender: TObject; FileName,
  NewFileName: TCBString; var UserContext: Pointer;
  var ProcessRequest: Boolean);
var
  Context: TEncryptContext;
  SrcFiltered, DstFiltered: Boolean;
begin
//  ShowMessage('Moviendo Archivo...');
  ProcessRequest:= true;
{  ProcessRequest := False;
  SrcFiltered := cbfFilter.IsFileFiltered(FileName);
  DstFiltered := cbfFilter.IsFileFiltered(NewFileName);
  if SrcFiltered xor DstFiltered then
    begin
      if UserContext <> nil then
        Context := TEncryptContext(UserContext)
      else
        Context := TEncryptContext.Create(cbfFilter, FileName);
      try
        Context.MoveFile(FileName, NewFileName, SrcFiltered, DstFiltered);
      finally
        if UserContext = nil then
          Context.Free;
      end;
      AddToLog(Format('RenameOrMoveFileC %s %s', [FileName, NewFileName]));
    end
  else
    ProcessRequest := True;
}
end;

procedure Tfrm_main.cbfFilterSetAllocationSizeC(Sender: TObject;
  FileName: TCBString; var AllocationSize: Int64; var UserContext: Pointer;
  var ProcessRequest: Boolean);
begin
  ProcessRequest := True;
end;

procedure Tfrm_main.cbfFilterSetEndOfFileC(Sender: TObject; FileName: TCBString;
  var EndOfFile: Int64; var UserContext: Pointer; var ProcessRequest: Boolean);
var
  Context: TEncryptContext;
begin
  Context := TEncryptContext(UserContext);
  Context.CurrentSize := EndOfFile;
  ProcessRequest := True;
end;

procedure Tfrm_main.cbfFilterSetFileAttributesC(Sender: TObject;
  FileName: TCBString; var CreationTime, LastAccessTime,
  LastWriteTime: TDateTime; var FileAttributes: Cardinal;
  var UserContext: Pointer; var ProcessRequest: Boolean);
begin
  ProcessRequest := True;
end;

procedure Tfrm_main.cbfFilterSetFileSecurityC(Sender: TObject;
  FileName: TCBString; SecurityInformation: Cardinal;
  SecurityDescriptor: Pointer; Length: Cardinal; var ProcessRequest: Boolean);
begin
  ProcessRequest := True;
end;

procedure Tfrm_main.cbfFilterWriteFileC(Sender: TObject; FileName: TCBString;
  var Position: Int64; Buffer: PByte; var BytesToWrite: Cardinal;
  var UserContext: Pointer; var ProcessRequest: Boolean);
var
  Context: TEncryptContext;
begin
  Context := TEncryptContext(UserContext);
  Context.Write(Position, Buffer, BytesToWrite);
  ProcessRequest := False;
end;

// Esta funcion esta iendo llamada por un hilo!.
function Tfrm_main.conectarTCP: boolean;
begin
  try
    TCPClient.Host:= v_ServerIP;
    TCPClient.Port:= StrToInt(v_ServerPort);
    TCPClient.Connect;
    result:=true;
  except
    // no hay coneccion con servidor.
//    ShowMessage('No hay conexion con Servidor, revise param de XML o Red');
    result:=false;
  end;
end;

procedure Tfrm_main.deleteFilter(Sender: TObject);
begin
  cbfFilter.DeleteAllFilterRules;
  cbfFilter.DetachFilter;
end;

procedure Tfrm_main.Desconectar;
begin
  //  enviamos mensaje al servidor para decirle que nos vamos!.

end;

procedure Tfrm_main.FormActivate(Sender: TObject);
var
  sRegKey: String;
begin
  // Procedemos con la instalacion de la Aplicacion Cliente
  instalador;
  // ahora registramos el driver.
  KeyFile := ChangeFileExt(Application.ExeName, '.xml');
  XML.FileName:= KeyFile;
  v_ServerIP:= XML.Root.Items.ItemNamed['ServerIP'].Value;
  v_ServerPort:= XML.Root.Items.ItemNamed['ServerPort'].Value;
  v_extBasica:= XML.Root.Items.ItemNamed['ExtBasica'].Value;
  sRegKey:= XML.Root.Items.ItemNamed['Serie'].Value;
  //
  if sRegKey = '' then
    sRegKey := Dialogs.InputBox('Licencia',
      'Especifique la clave de licencia para Callback', '');
  try
    if sRegKey = '' then
      raise Exception.Create('La Licencia no es valida.')
    else
      TCallbackFilter.SetRegistrationKey(sRegKey);
  except
    on E: Exception do
      begin
        Application.ShowException(E);
        Application.Terminate;
      end;
  end;
  //
  if (installDriver) and (not filtrando) then
  begin
    setFilter(v_extBasica);
    // revisar si hay registros anteriores
    loadRegFilter;
    // ***********************************
  end;

  if commServer=nil then
  begin
    commServer:= TCommServer.Create(false);
    commServer.Priority:= tpNormal;
  end;
end;

procedure Tfrm_main.loadRegFilter;
var
  fF:TProcessFilter;
  xff, t:integer;
  valor:String[250];
begin
  ff:= TProcessFilter.Create;
  xff:= ff.getCountFilter;  // cuantos registros hay!.
  for t:=0  to (xff-1) do
  begin
    valor:= ff.getRegister(t);
    if valor<>'' then
      setFilter(valor);
  end;
end;

procedure Tfrm_main.addRegFilter(filtro:String);
var
  fF:TProcessFilter;
begin
  // RMB
  ff:= TProcessFilter.Create;
  ff.addFilter(filtro);
  ff.BSClose;
end;


procedure Tfrm_main.delRegFilter(filtro:String);
var
  fF:TProcessFilter;
begin
  // RBM
  ff:= TProcessFilter.Create;
  ff.delFilter(filtro);
end;

procedure Tfrm_main.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  killThread:= true;

  commServer.Terminate;
  desconectar;
  TCPClient.Disconnect;
  memo1.Lines.add('Deteniendo Thread...');
  memo1.Lines.add('Cerrando conexiones...');
  memo1.Lines.add('Close app');
//  sleep(500);
end;

procedure Tfrm_main.FormCreate(Sender: TObject);
begin
// frm_main.Left:= 1400;
// frm_main.Top:= 1400;
  filtrando:= false;
  killThread:= false;
  frm_acerca:= TAboutBox.Create(nil);
  msnPopup:= TMSNPopUp.Create(nil);
  msnPopup.Title:='BSProtector';
  msnPopup.URL:='www.bsperu.com';
  msnPopup.TimeOut:= 2;
  // levantamos nuestro hilo de comunicaciones con Servidor.
  Memo1.Lines.Add('Iniciado...');
  cadenaFilfer:='';
end;

procedure Tfrm_main.FormDestroy(Sender: TObject);
begin
  if cbfFilter.Active then DeleteFilter(Self);
  // matamos el hilo encargado de comunicaciones
  commServer.Terminate;
  FreeAndNil( commServer );
  // cerramos comunicaciones
  TCPClient.Disconnect;
  FreeAndNil(frm_acerca);
end;

// Copia los achivos a la carpetadel sistema y procede a crear un registro
// en el sistema operativo. (RegEdit).
procedure Tfrm_main.instalador;
var
  dirDestino:String;
  BootExec1:TBootExec;
begin
  dirDestino:= Application.ExeName;
  BootExec1:=TBootExec.Create;
  try
    BootExec1.ProgramName:='BSPClient';
    BootExec1.ExeName:=dirDestino;
    BootExec1.RunOnce:=FALSE;
    BootExec1.CurrentUser:=FALSE;
    try
      BootExec1.Add;
    except
      //Aqui si hubo algun problema al a&#241;adirlo:
      on e: EBootExecError do begin
        self.Show;
        ShowMessage( 'Hubo algun problema al intentar a&#241;adir el programa al arranque...'+
                     'El mensaje de error fu&#233;: '+ e.Message );
      end; //on EBootExecError
    end;
  finally
    BootExec1.Free;
  end;
end;

function Tfrm_main.installDriver: boolean;
var
  RebootNeed: Boolean;
  DriverInstalled: Boolean;
  FileVersionHigh, FileVersionLow: LongInt;
  ServiceStatus: TServiceStatus;
begin
   TCallbackFilter.GetDriverStatus(FProductID, DriverInstalled,
      FileVersionHigh, FileVersionLow, @ServiceStatus);
   if not DriverInstalled then
   begin
     RebootNeed := False;
     Memo1.Lines.Add('Istalando Driver...' );
     TCallbackFilter.InstallDriver('cbfltfs.sys', FProductID, RebootNeed);
     if RebootNeed then
      memo1.Lines.Add('Debe Reiniciar PC')
     else memo1.Lines.Add('No necesita reiniciar PC');
     if RebootNeed then AskForReboot;
   end;
   result:= DriverInstalled;
end;

procedure Tfrm_main.setFilter(archivo:String);
begin
  cbfFilter.AddFilterCallbackRule(archivo,
    fltReadCallback or
    fltWriteCallback or
    fltCreateCallback or
    fltRenameCallback or
    fltSetSizesCallback or
    fltDeleteCallback or
    fltSetBasicInfoCallback or
    fltEnumerateDirectoryCallback or
    fltOpenCallback or
    fltCloseCallback
  );
  if not filtrando then
  begin
    cbfFilter.AttachFilter(10000);
    filtrando:= true;
    memo1.Lines.Add(' *** Filtro Activo');
  end;
  memo1.Lines.Add(' *** Considerado ' + archivo);
end;

procedure Tfrm_main.uninstallDriver;
var
  RebootNeed: Boolean;
begin
  RebootNeed := False;
  TCallbackFilter.UninstallDriver(FProductID, RebootNeed);
  if RebootNeed then AskForReboot;
end;

procedure Tfrm_main.WMSysCommand(var Msg: TWMSysCommand);
begin
  if Msg.CmdType = SC_CLOSE then Close;
  if (Msg.CmdType = SC_MINIMIZE) or
        (Msg.CmdType = SC_MAXIMIZE) then Ocultar;
end;

function Tfrm_main.GetWindowsDirectory: String;
var
  pcWindowsDirectory : PChar;
  dwWDSize           : DWORD;
begin
  dwWDSize := MAX_PATH + 1;
  GetMem( pcWindowsDirectory, dwWDSize );
  try
    if Windows.GetWindowsDirectory( pcWindowsDirectory, dwWDSize ) <> 0 then
      Result := pcWindowsDirectory;
  finally
    FreeMem( pcWindowsDirectory );
  end;
end;

procedure Tfrm_main.Ocultar;
begin
  self.Hide;
  ShowWindow(Application.Handle, SW_HIDE);
  SetWindowLong( Application.Handle, GWL_EXSTYLE,
               GetWindowLong(Application.Handle, GWL_EXSTYLE) or
               WS_EX_TOOLWINDOW and not WS_EX_APPWINDOW);
  msnPopup.Text:='Estoy como icono!';
  msnPopup.ShowPopUp;
end;

procedure Tfrm_main.Ocultar1Click(Sender: TObject);
begin
    Ocultar;
end;

procedure Tfrm_main.Reiniciar1Click(Sender: TObject);
begin
    msnPopup.Text:= 'Visualizando BSPeru Client';
    msnPopup.ShowPopUp;
    self.Show;
end;

{ TEncryptContext }

constructor TEncryptContext.Create(Filter: TCallbackFilter;
  FileName: TCBString);
var
  I: Integer;
  RootPath: TCBString;
  SystemInfo: TSystemInfo;
  SectorsPerCluster, BytesPerSector,
  NumberOfFreeClusters, TotalNumberOfClusters: Cardinal;
  FileInformation: WIN32_FILE_ATTRIBUTE_DATA;
begin
  FFilter := Filter;
  FHandle := FFilter.OpenFile(FileName);
  if FHandle <> INVALID_HANDLE_VALUE then
    IncrementRef;
  TotalNumberOfClusters := GetLastError;
  // determaining disk cluster size and memory page size
  RootPath := FileName;
  BytesPerSector := 0;
  SectorsPerCluster := 0;
  NumberOfFreeClusters := 0;
  TotalNumberOfClusters := 0;
  while Length(RootPath) > 0 do
    begin
      if GetDiskFreeSpaceW(PWideChar(RootPath), SectorsPerCluster, BytesPerSector,
        NumberOfFreeClusters, TotalNumberOfClusters) then
        Break;
      I := GetLastError;
      I := Length(RootPath);
      if RootPath[I] = '\' then
        Dec(I);
      while (I > 0) and (RootPath[I] <> '\') do
        Dec(I);
      SetLength(RootPath, I);
    end;
  GetSystemInfo(SystemInfo);
  FBufferSize := Max(SystemInfo.dwPageSize,
    SectorsPerCluster * BytesPerSector);
  // allocating buufer for read/write operations
  FBuffer := VirtualAlloc(nil, FBufferSize, MEM_COMMIT, PAGE_READWRITE);

  GetFileAttributesExW(PWideChar(FileName), GetFileExInfoStandard,
    @FileInformation);
  FCurrentSize := Int64(FileInformation.nFileSizeLow) or
    (Int64(FileInformation.nFileSizeHigh) shl 32);
end;

destructor TEncryptContext.Destroy;
begin
  if FBuffer <> nil then
    VirtualFree(FBuffer, FBufferSize, MEM_DECOMMIT);
  FFilter.CloseFile(FHandle);
  FHandle := 0;
  FRefCnt := 0;
  inherited;
end;

procedure TEncryptContext.Read(Position: Int64; Buffer: PByte;
  BytesToRead: Cardinal);
var
  CurrPos: Int64;
  SysBuf: PAnsiChar;
  Overlapped: TOverlapped;
  Completed, BufPos, SysBufPos: Cardinal;
begin
  SysBuf := PAnsiChar(Buffer);
  SysBufPos := 0;
  CurrPos := (Position div FBufferSize) * FBufferSize;
  while BytesToRead > 0 do
    begin
      // reading internal buffer
      FillChar(Overlapped, SizeOf(Overlapped), 0);
      Overlapped.Offset := CurrPos and $FFFFFFFF;
      Overlapped.OffsetHigh := (CurrPos shr 32) and $FFFFFFFF;
      if not ReadFile(FHandle, FBuffer^, FBufferSize, Completed,
        @Overlapped) or (Completed = 0) then
        begin
          Break;
        end;
      DecryptBuffer;
      // copying part of internal bufer into system buffer
      BufPos := Position - CurrPos;
      Completed := FBufferSize - BufPos;
      if Completed > BytesToRead then
        Completed := BytesToRead;
      Move(FBuffer[BufPos], SysBuf[SysBufPos], Completed);
      // preparing to next part of data
      Inc(Position, Completed);
      Inc(SysBufPos, Completed);
      Dec(BytesToRead, Completed);
      Inc(CurrPos, FBufferSize);
      if Position < CurrPos then
        Break;
    end;
end;

procedure TEncryptContext.Write(Position: Int64; Buffer: PByte;
  BytesToWrite: Cardinal);
var
  CurrPos: Int64;
  SysBuf: PAnsiChar;
  Overlapped: TOverlapped;
  Completed, BufPos, SysBufPos: Cardinal;
begin
  SysBuf := PAnsiChar(Buffer);
  SysBufPos := 0;
  CurrPos := (Position div FBufferSize) * FBufferSize;
  while BytesToWrite > 0 do
    begin
      if CurrentSize > 0 then
        begin
          // reading internal buffer
          FillChar(Overlapped, SizeOf(Overlapped), 0);
          Overlapped.Offset := CurrPos and $FFFFFFFF;
          Overlapped.OffsetHigh := (CurrPos shr 32) and $FFFFFFFF;
          if not ReadFile(FHandle, FBuffer^, FBufferSize, Completed,
            @Overlapped) or (Completed = 0) then
            begin
              Break;
            end
          else
            DecryptBuffer;
        end
      else
        FillChar(FBuffer^, FBufferSize, 0);
      // copying system buffer into internal bufer
      BufPos := Position - CurrPos;
      Completed := FBufferSize - BufPos;
      if Completed > BytesToWrite then
        Completed := BytesToWrite;
      Move(SysBuf[SysBufPos], FBuffer[BufPos], Completed);
      EncryptBuffer;
      // writing internal buffer
      FillChar(Overlapped, SizeOf(Overlapped), 0);
      Overlapped.Offset := CurrPos and $FFFFFFFF;
      Overlapped.OffsetHigh := (CurrPos shr 32) and $FFFFFFFF;
      if not WriteFile(FHandle, FBuffer^, FBufferSize, Completed,
        @Overlapped) or (Completed < FBufferSize) then
        begin
          Break;
        end;
      // preparing to next part of data
      Inc(Position, Completed);
      Inc(SysBufPos, Completed);
      Dec(BytesToWrite, Completed);
      Inc(CurrPos, FBufferSize);
      if Position < CurrPos then
        Break;
    end;
end;

type
  IO_STATUS_BLOCK = record
    {
    case Integer of
    0: (Status: DWORD);
    1: (APointer: Pointer);
    end;
    }
    Status: DWORD;
    Information: PLongWord;
  end;
  PIO_STATUS_BLOCK = ^IO_STATUS_BLOCK;

function NtSetInformationFile(FileHandle: THandle;
  IoStatusBlock: PIO_STATUS_BLOCK;
  FileInformation: Pointer;
  Length: LongWord;
  FileInformationClass: DWORD): DWORD; stdcall; external 'ntdll.dll';

{
NTAPI

    __in HANDLE FileHandle,
    __out PIO_STATUS_BLOCK IoStatusBlock,
    __in_bcount(Length) PVOID FileInformation,
    __in ULONG Length,
    __in FILE_INFORMATION_CLASS FileInformationClass
    );
}

procedure TEncryptContext.MoveFile(FileName, NewFileName: TCBString; Decrypt,
  Encrypt: Boolean);
var
  CurrPos: Int64;
  DstHandle: THandle;
  Completed, LastError: Cardinal;
  Overlapped: TOverlapped;
  Status: IO_STATUS_BLOCK;
  //DeleteFile: BOOLEAN;
begin
  DstHandle := FFilter.OpenFile(NewFileName);
  if DstHandle = INVALID_HANDLE_VALUE then
    DstHandle := FFilter.CreateFile(NewFileName);
  if DstHandle <> INVALID_HANDLE_VALUE then
    try
      CurrPos := 0;
      while CurrPos < CurrentSize do
        begin
          // reading internal buffer
          FillChar(Overlapped, SizeOf(Overlapped), 0);
          Overlapped.Offset := CurrPos and $FFFFFFFF;
          Overlapped.OffsetHigh := (CurrPos shr 32) and $FFFFFFFF;
          if ReadFile(FHandle, FBuffer^, FBufferSize, Completed,
            @Overlapped) and (Completed > 0) then
          if Decrypt then
            DecryptBuffer;
          if Encrypt then
            EncryptBuffer;
          // writing internal buffer
          FillChar(Overlapped, SizeOf(Overlapped), 0);
          Overlapped.Offset := CurrPos and $FFFFFFFF;
          Overlapped.OffsetHigh := (CurrPos shr 32) and $FFFFFFFF;
          if not WriteFile(DstHandle, FBuffer^, FBufferSize, Completed,
            @Overlapped) or (Completed < FBufferSize) then
            Break;
          // preparing to next part of data
          Inc(CurrPos, FBufferSize);
        end;
      CurrPos := CurrentSize;
      LastError := NtSetInformationFile(DstHandle, @Status, @CurrPos,
        SizeOf(CurrPos), 20); // FileEndOfFileInformation
      //FFilter.SetEndOfFile(DstHandle, CurrentSize);
      FFilter.DeleteFile(FileName);
    finally
      {
      {
      Completed := Cardinal((CurrentSize shr 32) and $FFFFFFFF);
      Completed := SetFilePointer(DstHandle, Integer(CurrentSize and $FFFFFFFF),
        @Completed, FILE_BEGIN);
      LastError := GetLastError;
      if (Completed = $FFFFFFFF) and (LastError <> 0) then
        begin
          SetLastError(LastError);
          RaiseLastWin32Error;
        end
      else
        SetEndOfFile(DstHandle);
      }
      FFilter.CloseFile(DstHandle);
      {
      DeleteFile := TRUE;
      LastError := NtSetInformationFile(FHandle, @Status, @DeleteFile,
        SizeOf(DeleteFile), 13); // FileDispositionInformation
      }
    end
  else
    begin
      RaiseLastWin32Error;
    end;
end;

procedure TEncryptContext.DecryptBuffer;
var
  I: Cardinal;
  c: String;
begin
  // leemos si tiene firma
  c:= AnsiChar(Byte(FBuffer[0]) xor $FF);
  c:= c + AnsiChar(Byte(FBuffer[1]) xor $FF);
  c:= c + AnsiChar(Byte(FBuffer[2]) xor $FF);
  c:= c + AnsiChar(Byte(FBuffer[3]) xor $FF);
  //
  for I := 0 to FBufferSize - 1 do
    FBuffer[I] := AnsiChar(Byte(FBuffer[I]) xor $FF);    // Llave en duro
end;

procedure TEncryptContext.EncryptBuffer;
var
  I: Cardinal;
begin
  for I := 0 to FBufferSize - 1 do
    FBuffer[I] := AnsiChar(Byte(FBuffer[I]) xor $FF); // Llave en duro.
end;

function TEncryptContext.IncrementRef: Integer;
begin
  Inc(FRefCnt);
  Result := FRefCnt;
end;

function TEncryptContext.DecrementRef: Integer;
begin
  if FRefCnt > 0 then Dec(FRefCnt);
  Result := FRefCnt;
end;

end.
#9808
Posted: 04/27/2009 01:15:22
by Eugene Mayevski (EldoS Corp.)

First of all, please test the sample applications on the test system and see if they work fine or crash.


Sincerely yours
Eugene Mayevski
Also by EldoS: MsgConnect
Cross-platform protocol-independent communication framework for building peer-to-peer and client-server applications and middleware components.

Reply

Statistics

Topic viewed 5736 times

Number of guests: 1, registered members: 0, in total hidden: 0




|

Back to top

As of July 15, 2016 EldoS Corporation will operate as a division of /n software inc. For more information, please read the announcement.

Got it!