KSpoold Disinfector 1.0 – Freeware
Copyright © Indra Gunawan, 2ind@mail.com
www.delphiexpert.wordpress.com

KSpoold Disinfector is a software that writen to restore Microsoft
Office files (Word, Excel, PPT etc.) from damaged file because of KSpoold virus.

KSpoold infect the docs files by mergeing these docs to the virus file,
original docs files will be delete & new file with the same name will be added
to cheating the users with new file extention: .EXE
So anytime you double click this infected file from explorer / open it using
shell api your computer will be infected too.

The software is provided “as-is,” without any express or implied warranty.
In no event shall the Author be held liable for any damages arising from
the use of the Software

The software is writen in Borland Delphi 7.
Full source-code also provided, any comments are noted of the following:

“The const SAMPLE_SIZE = 524; is taken from the following figure:

Microsoft Word & Excel using the same file header at the first 512,
so we get unique header at the first 12 byte after 512 offset
512 + 12 = 524 –> it’s my lucky number “

You can download sample of infected file by KSpoold here:
http://delphi-id.org/dpr/Downloads-index-req-viewdownloaddetails-lid-180.pas

And the complete source & compiled program:

kspoold-disinfecto…

Hosted by eSnips

Any comments are welcome. Please send me the copy if you’re make modification
TODO: – Batch directory processing (may one of you would be completing this todo?)

Code class snap-shot:

unit MainUnit;  
interface  
 { KSpoold Disinfector 1.0 - Freeware
  Copyright © Indra Gunawan, 2ind@mail.com   www.delphiexpert.wordpress.com
  LICENSE   ---------------------------------------------------------------------------
  Use and distribution of the library is permitted provided that all of   the following terms are accepted:    The software is provided "as-is," without any express or implied warranty.   In no event shall the Author be held liable for any damages arising from   the use of the Software.    All redistributions of the library files must be in their original,   unmodified form. Distributions of modified versions of the files is   permitted with express written permission of the Indra.   All redistributions of the library files must retain all   copyright notices and web site addresses that are currently in place,   and must include this list of conditions without modification.    None of the library may be redistributed for profit or as part of   another software package without express written permission of the Indra.   Redistribution of any of the component files in object form   (including but not limited to .PAS, .DCU and .OBJ formats)   is strictly prohibited without express written permission of the Indra.   --------------------------------------------------------------------------- }  uses   Windows, Messages, Classes, SysUtils, Controls, Forms,   Dialogs, StdCtrls;  const   SAMPLE_SIZE = 524;    { Microsoft Word & Excel using the same file header at the first 512,     so we get unique header at the first 12 byte after 512 offset     512 + 12 = 524 --> it's my lucky number        You can download sample of infected file by KSpoold here:     http://delphi-id.org/dpr/Downloads-index-req-viewdownloaddetails-lid-180.pas   }  type   IDEPatternRecognizer = interface   ['{9AB98B63-B58E-4D0A-B420-30E6F5E37E46}']     function GetSample(const FileName: WideString; out Sample: Pointer; Size: Integer): HRESULT; stdcall;     function SetSample(const PatternName: WideString; const Sample: Pointer; const Size: Integer): HRESULT; stdcall;     function RemoveSample(const PatternName: WideString): HRESULT; stdcall;     function EnumSamples(const Dest: TStrings): HRESULT; stdcall;     function RestoreInfectedFile(const FileName: WideString; var DestFileName: string): HRESULT; stdcall;   end;    TMainForm = class(TForm)     GroupBox1: TGroupBox;     ListBox1: TListBox;     Button1: TButton;     Button2: TButton;     Button3: TButton;     Button4: TButton;     procedure Button1Click(Sender: TObject);     procedure Button2Click(Sender: TObject);     procedure ListBox1Click(Sender: TObject);     procedure Button3Click(Sender: TObject);     procedure Button4Click(Sender: TObject);   private     { Private declarations }     FDEPR: IDEPatternRecognizer;   public     { Public declarations }     constructor Create(AOwner: TComponent); override;     destructor Destroy; override;   end;    TKSpoolInfPattern = class(TInterfacedObject, IDEPatternRecognizer)   private     FSamples: TStream;     function FindResourceOffset(const FileName, Sample: string): Int64;   protected     { IDEPatternRecognizer }     function GetSample(const FileName: WideString; out Sample: Pointer; Size: Integer): HRESULT; stdcall;     function SetSample(const PatternName: WideString; const Sample: Pointer; const Size: Integer): HRESULT; stdcall;     function RemoveSample(const PatternName: WideString): HRESULT; stdcall;     function EnumSamples(const Dest: TStrings): HRESULT; stdcall;     function RestoreInfectedFile(const FileName: WideString; var DestFileName: string): HRESULT; stdcall;   public     constructor Create; virtual;     destructor Destroy; override;   end;  var   MainForm: TMainForm;  implementation  uses IniFiles, Math, ShellApi;  {$R *.dfm}  { TMainForm }  constructor TMainForm.Create(AOwner: TComponent); begin   inherited;   FDEPR:= TKSpoolInfPattern.Create;   FDEPR.EnumSamples(ListBox1.Items); end;  destructor TMainForm.Destroy; begin   FDEPR:= nil;   inherited; end;  procedure TMainForm.Button1Click(Sender: TObject); var Dlg: TOpenDialog;     Buf: Pointer;     PattName: string; begin   Dlg:= TOpenDialog.Create(nil);   try     Dlg.Filter:= 'Microsoft Office Files (*.doc; *.xls)|*.doc;*.xls';     if Dlg.Execute then       if FDEPR.GetSample(Dlg.FileName, Buf, SAMPLE_SIZE) = S_OK then       begin         PattName:= UpperCase(ExtractFileExt(Dlg.FileName));         FDEPR.SetSample(PattName, Buf, SAMPLE_SIZE);         FreeMem(Buf);          ListBox1.Items.Add(PattName);       end;   finally     Dlg.Free;   end; end;  procedure TMainForm.Button2Click(Sender: TObject); begin   if MessageBox(Handle, 'Are you sure?', 'Confirm', MB_ICONWARNING or MB_YESNO) = mrYes then   begin     if FDEPR.RemoveSample(ListBox1.Items[ListBox1.ItemIndex]) = S_OK then     begin       ListBox1.DeleteSelected;       ListBox1.OnClick(nil);     end else MessageBox(Handle, 'Unable delete sample!', 'Failed', MB_ICONWARNING or MB_OK);   end; end;  procedure TMainForm.ListBox1Click(Sender: TObject); begin   Button2.Enabled:= ListBox1.ItemIndex >= 0; end;  procedure TMainForm.Button3Click(Sender: TObject); var Dlg: TOpenDialog;     Dest: string; begin   Dlg:= TOpenDialog.Create(nil);   try     Dlg.Filter:= 'Infected File (*.exe)|*.exe';     if Dlg.Execute then     begin       Dest:= ChangeFileExt(Dlg.FileName, '.clean.unk');       if FDEPR.RestoreInfectedFile(Dlg.FileName, Dest) = S_OK then       begin         if MessageBox(Handle, 'Succesully disinfecting the file. Open the file now?', 'Success', MB_ICONINFORMATION or MB_YESNO) = mrYes then           ShellExecute(0, 'open', PAnsiChar(Dest), '', '', SW_SHOW);       end else MessageBox(Handle, 'Unable disinfecting file!', 'Failed', MB_ICONWARNING or MB_OK);     end;   finally     Dlg.Free;   end; end;  procedure TMainForm.Button4Click(Sender: TObject); begin   MessageBox(Handle, 'KSpoold Disinfector 1.0 - Freeware'#13#10#13#10'Copyright © Indra Gunawan, 2ind@mail.com'#13#10'www.delphiexpert.wordpress.com',   'About Disinfecter', MB_ICONINFORMATION or MB_OK); end;  { TKSpoolRestore }  const CBufferSize = 1024;       BUFFER_SIZE = 4096;  constructor TKSpoolInfPattern.Create; var SampleFile: string; begin   SampleFile:= ChangeFileExt(ParamStr(0), '.samples.bin');    if FileExists(SampleFile) then     FSamples:= TFileStream.Create(SampleFile, fmOpenReadWrite)   else FSamples:= TFileStream.Create(SampleFile, fmCreate); end;  destructor TKSpoolInfPattern.Destroy; begin   FSamples.Free;   inherited; end;  function TKSpoolInfPattern.EnumSamples(const Dest: TStrings): HRESULT; var Mem: TMemIniFile; begin   Mem:= TMemIniFile.Create('');   try     FSamples.Seek(0, soFromBeginning);     Dest.LoadFromStream(FSamples);      Mem.SetStrings(Dest);     Mem.ReadSections(Dest);     Result:= S_OK;   finally     Mem.Free;   end; end;  function TKSpoolInfPattern.GetSample(const FileName: WideString;   out Sample: Pointer; Size: Integer): HRESULT; var F: TFileStream; begin   Result:= S_OK;   F:= TFileStream.Create(FileName, fmOpenRead);   try     GetMem(Sample, Size);     try       F.ReadBuffer(Sample^, Size);     except       FreeMem(Sample, Size);       Result:= E_POINTER;     end;   finally     F.Free;   end; end;  function TKSpoolInfPattern.FindResourceOffset(const FileName, Sample: string): Int64; var   FS: TFileStream;   Buf: PChar;   BufSize: Integer;   WorkPos: Int64;   Signature: string;   SignatureLen: integer;    function IsCorrectHeader(Data: PChar): Boolean;   begin     Result:= StrLComp(PChar(Signature), Data, SignatureLen) = 0;   end;    function FindSignatureInBlock(FilePos: Int64; var SignatureOffset: Int64): Boolean;   var     i: Integer;     SizeToCheck: Integer;   begin     Result:= False;     SizeToCheck:= min(FS.Size-FS.Position, BufSize)-SignatureLen;     FS.Read(Buf^, SizeToCheck);      for I:= 0 to SizeToCheck do       if (StrLComp(PChar(Signature), Buf+I, SignatureLen) = 0) then         if (IsCorrectHeader(Buf+i)) then           begin             Result:= True;             SignatureOffset:= FilePos + I + SignatureLen +                               SignatureLen;             Break;           end;   end;  begin   Result:= -1;   FS:= TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);   try     Signature:= Sample;     SignatureLen:= Length(Sample);     BufSize:= 10000;      Buf:= AllocMem(BufSize);     try       FS.ReadBuffer(Buf^, SignatureLen+SignatureLen);       if (StrLComp(PChar(Signature), Buf, SignatureLen) = 0) then         if (IsCorrectHeader(Buf)) then            Result:= 0;        if (Result < 0) then       begin         WorkPos:= 0;         while (WorkPos < FS.Size) do           if (FindSignatureInBlock(WorkPos, Result)) then             Break           else WorkPos:= WorkPos+BufSize-SignatureLen;       end;     finally       FreeMem(Buf, BufSize);     end;   finally     FS.Free;   end; end;  function TKSpoolInfPattern.RestoreInfectedFile(const FileName: WideString;   var DestFileName: string): HRESULT; var Mem: TMemIniFile;     Strs: TStrings;     Stream, Dest: TStream;      Sample: string;     SignOffset: Int64; begin   Mem:= TMemIniFile.Create('');   try     FSamples.Seek(0, soFromBeginning);      Strs:= TStringList.Create;     try       Strs.LoadFromStream(FSamples);        Mem.SetStrings(Strs);        Strs.Clear;       Mem.ReadSections(Strs);        while Strs.Count > 0 do       begin         Stream:= TMemoryStream.Create;         try           Mem.ReadBinaryStream(Strs[0], 'Sample', Stream);            Stream.Seek(0, soFromBeginning);           SetLength(Sample, Stream.Size);           Stream.ReadBuffer(Sample[1], Stream.Size);         finally           Stream.Free;         end;          SignOffset:= FindResourceOffset(FileName, Sample);         if SignOffset >= 0 then         begin           DestFileName:= ChangeFileExt(DestFileName, LowerCase(Strs[0]));           Dest:= TFileStream.Create(DestFileName, fmCreate);           try             Stream:= TFileStream.Create(FileName, fmOpenRead);             try               Stream.Seek(SignOffset, soFromBeginning);               Dest.CopyFrom(Stream, Stream.Size - SignOffset);               Result:= S_OK;               Exit;             finally               Stream.Free;             end;           finally             Dest.Free;           end;         end;          Strs.Delete(0);       end;     finally       Strs.Free;     end;   finally     Mem.Free;   end;    Result:= S_FALSE; end;  function TKSpoolInfPattern.RemoveSample(   const PatternName: WideString): HRESULT; var Mem: TMemIniFile;     Strs: TStrings; begin   Mem:= TMemIniFile.Create('');   try     FSamples.Seek(0, soFromBeginning);      Strs:= TStringList.Create;     try       Strs.LoadFromStream(FSamples);        Mem.SetStrings(Strs);       if Mem.SectionExists(PatternName) then       begin         Mem.EraseSection(PatternName);          Strs.Clear;         Mem.GetStrings(Strs);          FSamples.Size:= 0;         Strs.SaveToStream(FSamples);         Result:= S_OK;       end else Result:= S_FALSE;     finally       Strs.Free;     end;   finally     Mem.Free;   end; end;  function TKSpoolInfPattern.SetSample(const PatternName: WideString;   const Sample: Pointer; const Size: Integer): HRESULT; var Mem: TMemIniFile;     Strs: TStrings;     Stream: TStream; begin   Mem:= TMemIniFile.Create('');   try     FSamples.Seek(0, soFromBeginning);      Strs:= TStringList.Create;     try       Strs.LoadFromStream(FSamples);       Mem.SetStrings(Strs);     finally       Strs.Free;     end;      Stream:= TMemoryStream.Create;     try       Stream.WriteBuffer(Sample^, Size);       Stream.Seek(0, soFromBeginning);       Mem.WriteBinaryStream(PatternName, 'Sample', Stream);     finally       Stream.Free;     end;      Strs:= TStringList.Create;     try       Mem.GetStrings(Strs);       FSamples.Size:= 0;       Strs.SaveToStream(FSamples);     finally       Strs.Free;     end;      Result:= S_OK;   finally     Mem.Free;   end; end;  end.

Writing what I’m working-on sounds nice to keep track in the future, so here’s:

unit DECoreIntf;  { This unit contains graphical core, framework & resource manager interfaces   Author: Indra Gunawan   Date: 06-11-2007   Modified: 06-14-2007 }  interface  { enable this Compiler Directive if you're an 3rd party class writer } {$DEFINE EXPORT_HEADER}  uses Windows, Classes   {$IFDEF EXPORT_HEADER},   DECoreTypes   {$ENDIF};  type   {$IFDEF EXPORT_HEADER}   {PColor32 = ^TColor32;   TColor32 = type Cardinal;    PColor32Array = ^TColor32Array;   TColor32Array = array [0..0] of TColor32;   TArrayOfColor32 = array of TColor32;    PFloat = ^TFloat;   TFloat = Single;    PFloatPoint = ^TFloatPoint;   TFloatPoint = record     X, Y: TFloat;   end;    PFloatRect = ^TFloatRect;   TFloatRect = packed record     case Integer of       0: (Left, Top, Right, Bottom: TFloat);       1: (TopLeft, BottomRight: TFloatPoint);   end;}    TDragState = (dsNone, dsLock, dsMove, dsSizeL, dsSizeT, dsSizeR, dsSizeB,     dsSizeTL, dsSizeTR, dsSizeBL, dsSizeBR);    TRBHandles = set of (rhCenter, rhSides, rhCorners, rhFrame,     rhNotLeftSide, rhNotRightSide, rhNotTopSide, rhNotBottomSide,     rhNotTLCorner, rhNotTRCorner, rhNotBLCorner, rhNotBRCorner);   {$ENDIF}    { Interface Declarations }    PResourceEntry = ^TResourceEntry;   TResourceEntry = packed record     IID: TGUID;     Instance: IInterface;     { instance need maintenance the list dynamicly       so we use semi circular double-linked-list rather than fixed array.       indexing also supported by HashedList or TList }     Prev: PResourceEntry;  // if entry is root, Prev may linked to it self or nil     Next: PResourceEntry;   end;    {PResourceTable = ^TResourceTable;   TResourceTable = packed record     EntryCount: Integer;     Entries: array[0..9999] of PResourceEntry;   end;}    { forward declarations }    IDEGraphicLayer = interface;   IDEProxyDispatcher = interface;   IDEClassRegistry = interface;    { ----- resource manager interfaces ----- }    { IDECachedResources only accept unique TGUID resource }    IDECachedResource = interface   ['{0E55234C-1E19-4D1E-B6E7-088C6CF5B23A}']     function GetResourceEntry(IID: TGUID; out Entry: PResourceEntry): HRESULT; stdcall;     function AddResource(IID: TGUID; Res: IInterface): HRESULT; stdcall;     function GetResource(Res: TGUID; out Intf): HRESULT; stdcall;     function GetFirstResourceEntry(out Entry: PResourceEntry): HRESULT; stdcall;     function GetLastResourceEntry(out Entry: PResourceEntry): HRESULT; stdcall;     function RemoveResource(Res: TGUID): HRESULT; stdcall;     function Clear: HRESULT; stdcall;     function ResourceExist(Res: TGUID): HRESULT; stdcall;     { indexing supports }     function GetCount: Integer; stdcall;     function GetResourceEntryByIndex(Index: Integer; out Entry: PResourceEntry): HRESULT; stdcall;     function GetResourceByIndex(Index: Integer; out Intf): HRESULT; stdcall;     function RemoveResourceByIndex(Index: Integer): HRESULT; stdcall;     { persistent supports }     function WriteToStream(Dest: TStream): HRESULT; stdcall;     function ReadFromStream(Source: TStream): HRESULT; stdcall;   end;    IDESystemResource = interface   ['{95B022AB-0ECF-4CC9-93CF-BBA176C28822}']     { Opens/creates a file. 'FileName' parameter must contain full path. Folders are       created automatically. 'Mode' parameter is the same as in the TFileStream.Create.       fmCreate: Creates/overwrites a file.       fmOpenRead, fmOpenWrite, fmOpenReadWrite: Opens existing file in read-write mode.       Read-only mode is not supported (but is automatically enforced if underlying       storage is open read-only.       @param   fileName Absolute path of the file to be created/open. Must start with a                         folder delimiter (\ or /) and can contain any ascii character                         except #0, \ and /.       @returns Nil if file does not exist and mode is not fmCreate; an object                representing the file otherwise. Caller is responsible for destroying this                object. }     function  OpenFile(const FileName: WideString; Mode: Word): TStream; stdcall;     procedure CreateFolder(const FolderName: WideString); stdcall;     { Moves a file or folder. }     procedure Move(const ObjectName, NewName: WideString); stdcall;     { Deletes a file or folder. When deleting folder, all subfolders and files are automatically deleted. }     procedure Delete(const ObjectName: WideString); stdcall;     function  FileExists(const FileName: WideString): Boolean; stdcall;     function  FolderExists(const FolderName: WideString): Boolean; stdcall;     procedure FileNames(const FolderName: WideString; Files: TStrings); stdcall;     { Returns list of folders in folder 'FolderName'. }     procedure FolderNames(const FolderName: WideString; Folders: TStrings); stdcall;     { Fast way to check if folder is empty. }     function  IsFolderEmpty(const FolderName: WideString): Boolean; stdcall;   end;    TDECreateProc = function: TObject; stdcall;    PClassEntry = ^TClassEntry;   TClassEntry = packed record     CreateProc: TDECreateProc;     HLibModule: Longword;     Icon: Pointer;     IconSize: Longword;      Name: Widestring;     Description: Widestring;     Author: Widestring;     Version: Longint; // Hi word & Lo word      { advance object hook, Garbage Collector related }     AfterConstruction: Pointer;     BeforeDestruction: Pointer;   end;    { External module library methods }    { Host application / framework will be first check is TExtLibProxyDispatcherSignature     method avaliable in a DLL, then check the signature is compatible or not }   TExtLibProxyDispatcherSignature = function (out Signature: TGUID): HRESULT; stdcall;    { After signature match, next, system initiate call to a register process (IDEClassRegistry).     Be aware for 2nd, 3rd, ... class, set HLibModule to 0 (zero),     assign HLibModule value that come from caller only for the 1st register process,     duplicate HLibModule will cause error on FreeLibrary call }   TExtLibProxyDispatcherRegister = function (Registry: IDEClassRegistry; HLibModule: Longword; out ClassCount: Integer): HRESULT; stdcall;    { Base interface rights for IDEClassRegistry }    TDENotifyEvent = procedure (Sender: TObject; Action, WParam, LParam: Longint) of object; stdcall;    PNotifyEventEntry = ^TNotifyEventEntry;   TNotifyEventEntry = packed record     Proc: TDENotifyEvent;     RefCount: Integer;   end;    IDENotifier = interface   ['{A85D46B7-7C68-400C-857E-B37A0853F9E8}']     function RegisterNotification(ANotify: TDENotifyEvent): HRESULT; stdcall;     function UnregisterNotification(ANotify: TDENotifyEvent): HRESULT; stdcall;     function Notify(Sender: TObject; Action, WParam, LParam: Longint): HRESULT; stdcall;   end;    IDEClassRegistryEntry = interface   ['{30AFB9F4-60CB-40E7-A41B-24AEA79A7DB5}']   end;    IDEClassRegistry = interface(IDENotifier)   ['{2C58AC7B-B19B-4226-9454-3947D45511F1}']     function RegisterClass(AClass: TClass; CreateProc: TDECreateProc; HLibModule: Longword;       const IconData: Pointer; IconDataSize: Longword; Name, Description, Author: Widestring;       Version: Longint): HRESULT; stdcall;     function CreateObject(AClassName: WideString; out Intf): TObject; stdcall;   end;    { Visual supports - Menus, Toolbar & ToolWindow }    IDEUserInterface = interface(IDEClassRegistryEntry)   ['{93269A85-8ADA-424D-B734-2924F09ADF5A}']     function RegisterImageListIcon(const IconData: Pointer; DataSize: Longint): Integer; stdcall;      function GetText(UIHandle: Longword): Widestring; stdcall;     procedure SetText(UIHandle: Longword; Value: Widestring); stdcall;      function GetValues(UIHandle: Longword; Dest: TStrings): HRESULT; stdcall;     function SetValues(UIHandle: Longword; Value: TStrings): HRESULT; stdcall;      function GetVisiblity(UIHandle: Longword): Boolean; stdcall;     procedure SetVisiblity(UIHandle: Longword; Value: Boolean); stdcall;      property Text[UIHandle: Longword]: Widestring read GetText write SetText;     property Visibility[UIHandle: Longword]: Boolean read GetVisiblity write SetVisiblity;   end;    TDEUserInterfaceEvent = procedure (Sender: IDEUserInterface; UIHandle: Longword) of object; stdcall;    IDEToolbar = interface(IDEUserInterface)   ['{3ED33565-1FFE-414E-A34E-DFD9DD53ED70}']     { For each, return the handle of user interface }     function Add(const Index, ImageIndex: Integer; const Title, Hint: Widestring; const OnClick: TDEUserInterfaceEvent): Longword; stdcall;     function AddEdit(const Index: Integer; const Hint: Widestring; const OnChange: TDEUserInterfaceEvent): Longword; stdcall;     function AddCombo(const Index: Integer; const Hint: Widestring; const OnChange: TDEUserInterfaceEvent): Longword; stdcall;     function AddSpinEdit(const Index: Integer; const Hint: Widestring; const OnChange: TDEUserInterfaceEvent): Longword; stdcall;     function AddSeparator(const Index: Integer): Longword; stdcall;      function GetDockHandle: Longword; stdcall;     procedure SetDockHandle(Value: Longword); stdcall;      function GetVisible: Boolean; stdcall;     procedure SetVisible(Value: Boolean); stdcall;      property DockHandle: Longword read GetDockHandle write SetDockHandle;     property Visible: Boolean read GetVisible write SetVisible;   end;    IDEFrameworkEnv = interface   ['{3A5809FF-91C3-41A1-B54F-2CA688AEF36D}']     { SystemResource contains global resources (image, video, audio, text, binary etc.) related to a project.       storage structure virtualy using FAT architecture, equal with physical FAT, you can create/delete/read/write folder or file }     function GetSystemResource: IDESystemResource; stdcall;      { ProxyDispatcherRegistry contains registered implementation classes of IDEProxyDispatcher       interface, you may register your own/3rd party class to be able to communicate with the framework.       Registering from external library DLL/Obj also supported using specified rule(s) }     function GetProxyDispatcherRegistry: IDEClassRegistry; stdcall;      { CachedResource may contains any required cache of IInterface descendant,       ex. you may add your own themmed thumbnails border to share with other.       For default, system doesn't save these contents to project file, but optionaly you       may save your self inside your structure stream format or write it in SystemResource. }     function GetCachedResource: IDECachedResource; stdcall;      { External module loader supports }     function LoadExternalModule(ModulePath, FileExt: WideString; Dest: IDEClassRegistry): HRESULT; stdcall;     function LoadExternalProxyDispatcher(ModulePath, FileExt: WideString): HRESULT; stdcall;      { Project control }     function NewProject: HRESULT; stdcall;     function OpenProject(const AFileName: WideString): HRESULT; stdcall;     function CloseProject: HRESULT; stdcall;     function SaveAs(const AFileName: WideString): HRESULT; stdcall;     function Save: HRESULT; stdcall;     function GetModified: Boolean; stdcall;     function GetFileName: WideString; stdcall;     procedure Changed; stdcall;      { System }     function Uninstall: HRESULT; stdcall;      { Visual User Interface }     function DeInitializeVisualControls: HRESULT; stdcall;     function GetToolPalette: IDEToolbar; stdcall;      property SystemResource: IDESystemResource read GetSystemResource;     property ProxyDispatcherRegistry: IDEClassRegistry read GetProxyDispatcherRegistry;     property CachedResource: IDECachedResource read GetCachedResource;     property FileName: WideString read GetFileName;     property Modified: Boolean read GetModified;      property ToolPalette: IDEToolbar read GetToolPalette;   end;    { graphical interfaces }    IDEBitmap = interface   ['{AD2A0F91-2820-4C6C-BC58-1611C02038A8}']     function  GetWidth: Integer; stdcall;     procedure SetWidth(Value: Integer); stdcall;     function  GetHeight: Integer; stdcall;     procedure SetHeight(Value: Integer); stdcall;     function  SetSize(NewWidth, NewHeight: Integer): Boolean; stdcall;     function  GetEmpty: Boolean; stdcall;     function  GetMeasuringMode: Boolean; stdcall;     function  GetBitmapHandle: HBITMAP; stdcall;     function  GetBitmapInfo: TBitmapInfo; stdcall;     function  GetHandle: HDC; stdcall;     function  GetBits: PColor32Array; stdcall;     function  GetPixelPtr(X, Y: Integer): PColor32; stdcall;     function  GetScanLine(Y: Integer): PColor32Array; stdcall;     function  GetPixel(X, Y: Integer): TColor32; stdcall;     procedure SetPixel(X, Y: Integer; Value: TColor32); stdcall;      procedure Changed; stdcall;     procedure Clear; stdcall;     procedure Reset(FillColor: TColor32); stdcall;      procedure ResetAlpha; stdcall;     procedure ResetAlphaValue(const AlphaValue: Byte); stdcall;      { properties }      property BitmapHandle: HBITMAP read GetBitmapHandle;     property BitmapInfo: TBitmapInfo read GetBitmapInfo;     property Handle: HDC read GetHandle;      property Bits: PColor32Array read GetBits;     property PixelPtr[X, Y: Integer]: PColor32 read GetPixelPtr;     property ScanLine[Y: Integer]: PColor32Array read GetScanLine;     property Pixel[X, Y: Integer]: TColor32 read GetPixel write SetPixel;      property Width: Integer read GetWidth write SetWidth;     property Height: Integer read GetHeight write SetHeight;     property Empty: Boolean read GetEmpty;     property MeasuringMode: Boolean read GetMeasuringMode;   end;    IDEGraphicLayer = interface   ['{19267F9A-51DF-4982-B628-AE6F99157FE6}']     function  DoHitTest(X, Y: Integer): Boolean; stdcall;     function  GetLocation: TFloatRect; stdcall;     procedure SetLocation(Value: TFloatRect); stdcall;     function  GetAdjustedLocation: TFloatRect; stdcall;     function  GetScaled: Boolean; stdcall;     procedure SetScaled(Value: Boolean); stdcall;     function  GetProxyDispatcher: IDEProxyDispatcher; stdcall;     function  Paint(Buffer: IDEBitmap): HRESULT; stdcall;      property Location: TFloatRect read GetLocation write SetLocation;     property Scaled: Boolean read GetScaled write SetScaled;     property ProxyDispatcher: IDEProxyDispatcher read GetProxyDispatcher;   end;    { TODO: }   IDEGraphicFilter = interface   ['{02470323-C5B5-4435-8D03-8FF4F3BE3286}']     function ApplyFilter: Boolean; stdcall;   end;    { InteractiveStyler used to create different behavior for drag and drop & mouse operations }    IDEInteractiveStyler = interface   ['{E4D9B94B-77A4-4D69-9535-D252C47A10C7}']     function ApplyStyle(Target: IDEGraphicLayer; Shift: TShiftState; MousePos: TPoint; OldLocation: TFloatRect;       var L, T, R, B: Single; Mx, My, W, H, MoveDirX, MoveDirY: Single): Boolean; stdcall;   end;    { This proxy dispatcher present to the class writer }    IDEProxyDispatcher = interface(IDEClassRegistryEntry)   ['{B08AF04B-6AF0-45D6-A11A-C0F96CD3E7C5}']     { interactive supports }     procedure MouseDown(Button: Word; Shift: TShiftState; X, Y: Integer); stdcall;     procedure MouseMove(Shift: TShiftState; X, Y: Integer); stdcall;     procedure MouseUp(Button: Word; Shift: TShiftState; X, Y: Integer); stdcall;     function  GetDragState(X, Y: Integer): TDragState; stdcall;     function  GetRubberbandHandler: TRBHandles; stdcall;     function  GetInteractiveStyler: IDEInteractiveStyler; stdcall;     { drawing supports }     function  DoPaint(Layer: IDEGraphicLayer; Buffer: IDEBitmap): HRESULT; stdcall;     { persistent supports }     function  WriteToStream(Dest: TStream): HRESULT; stdcall;     function  ReadFromStream(Source: TStream): HRESULT; stdcall;      {function WriteData(Dest: IXMLNode): HRESULT; stdcall;     function ReadData(Source: IXMLNode): HRESULT; stdcall;}      property RubberbandHandler: TRBHandles read GetRubberbandHandler;     property InteractiveStyler: IDEInteractiveStyler read GetInteractiveStyler;   end;    { Base abstract class used by 3rd party class,     you should create proxy/descendants using this class or     do it your self with refer to IDEProxyDispatcher interface }    TDEProxyDispatcher = class(TInterfacedObject, IDEClassRegistryEntry, IDEProxyDispatcher)   protected     procedure MouseDown(Button: Word; Shift: TShiftState; X, Y: Integer); virtual; stdcall; abstract;     procedure MouseMove(Shift: TShiftState; X, Y: Integer); virtual; stdcall; abstract;     procedure MouseUp(Button: Word; Shift: TShiftState; X, Y: Integer); virtual; stdcall; abstract;     function  GetDragState(X, Y: Integer): TDragState; virtual; stdcall; abstract;     function  GetRubberbandHandler: TRBHandles; virtual; stdcall; abstract;     function  GetInteractiveStyler: IDEInteractiveStyler; virtual; stdcall; abstract;     function  DoPaint(Layer: IDEGraphicLayer; Buffer: IDEBitmap): HRESULT; virtual; stdcall; abstract;     function  WriteToStream(Dest: TStream): HRESULT; virtual; stdcall; abstract;     function  ReadFromStream(Source: TStream): HRESULT; virtual; stdcall; abstract;   end;  implementation  end.
 

Finally, I decide to publish our TLogin 1.0 – Standard Edition property as Shareware.

TLogin – simplify you to manage User Rights, add multiuser and user rights functionality to your application with just a few mouse clicks.

Allows to control the user access to your app. GUI components (menus, buttons, check boxes, radio, .., everything on your form) and to any non visual functionality. Just drag, drop and run.

With TLogin you can:
- Build the security model of your app. at design time with few mouse clicks
- Add and remove users on fly
- Change users profile on fly
- Add/remove securized items on fly
- Securize non GUI functionalities
- Predefined User Groups – Supervisors, Power Users, …
- Much more…

Here’s some comments (taken from some friend words):
- Very user friendly user interface (UI nya sangat mudah dipahami dan dioperasikan)
- All Dataset descendants will be supported
- Simple drag & drop management
- User & group management
- User Rights to control any controls/components avaliable on any forms
- Exclusive Watch… a thread safe control state monitoring feature to prevent external hook (fitur checking jikalau ada ‘pihak’ yang mencoba iseng meng-invoke / hook / c-r-a-c-k ‘rights’ suatu control)
- Support both design-time & runtime descripting the rights & manage accounts
- Run As feature… (pada saat login sebagai non admin, seseorang bisa meng-interrupt tanpa harus log-out utk menjalankan task yg butuh authorizasi admin rights)
- Store the security description as you like (database, binary file)
- Synch-Data-Synch support… synchronizing existing users data as well as TLogin known data format.
- etc.

Here’s some screen shoot:

Download VCL components (Delphi 7 & BDS2006) also some demo application from here:

Hosted by eSnips

This software is distributed as shareware. It is not free. You may use the software for a trial period of thirty (30) days, at no cost to you, to determine if it fits your needs. If you decide to use the software, you shall register it and pay the applicable registration fee USD$ 39.00 (Single Developer License).
The Shareware (restricted) version may be freely distributed, as long as no fees are charged and original packaging, the above copyright notice and documentation are retained.

Single Developer License (USD$ 39.00) Corporate License (USD$ 89.00)

Baru ada waktu utk mempublikasikan

Hasil ketikan daku berikut adalah program yg daku ajukan sebagai skripsi S1, ide dibuatnya program ini karena pada saat skripsi ini diajukan, komponen report (delphi 5) yg ada pada waktu itu cuman Quick Report, daku paling sebel design report pake QReport hihi, tapi gimana lagi, adanya cuman itu. Akhirnya dng setengah malas-malasan daku angkat topik ini, hehehe lumayan dapet A
Bertepatan setelah ujian selesai dilaksanakan dan daku dinyatakan lulus, FreeReport baru kemudian muncul menyusul wakakak…

Basa-basi diambil dari Help aplikasi, 4 tahun yang lalu xixix (Help-helepan)

Program Pengolah Laporan ini dirancang dan dibuat untuk mempermudah pembuatan laporan berbasis database dalam program pengolah laporan.

Salah satu cara untuk menyajikan suatu informasi adalah dengan cara membuat laporan berdasar data yang telah melalui proses penyaringan. Data yang telah disaring dapat berupa rekapitulasi keuangan, transaksi penjualan atau pembelian berdasar tanggal, maupun informasi penting lainnya.

Dengan Program Pengolah Laporan ini mampu diaplikasikan pada segala macam format laporan dan data.

Program pengolah laporan ini bisa dijalankan di semua versi Microsoft Windows, kecuali Windows 3.1.x, dan kompatibel dengan segala merek printer dengan beragam resolusi.

Kompiler: Delphi 5, 6, 7 atau versi terbaru

Semua object dalam InsightReport melakukan drawing menggunakan scripting (Pascal), so siapa aja bisa dengan mudah membuat shape/object baru yg kemudian dapat langsung digunakan. Berikut snapshot ScriptEditor+Debugger :

Dan tidak lupa, seperti ReportEngine modern lainnya, terdapat window utk manipulasi properties objects:

Serta tidak lupa fasilitas wizard utk koneksi ke database (ADO & BDE based pada waktu itu), Query builder & Fields Explorer…

Snapshot diatas adalah Report Designer yg digunakan utk men-design report, dapat dipanggil langsung dari IDE (Delphi) atau pada waktu Runtime (persis macam Free/FastReport, siapa yg contekan ya xixix), So… beberapa komponen visual & non visual juga disertakan; jadi dapat diinstal dalam IDE, lagi2 mirip2 ama FreeReport <sebel>, cuman komponen report dibuat simple, support embedded report design data (compiled right to your Exe, ataupun load from external file)
Tidak ada embel2 TRLabel atau sejenisnya, karena semua object yg digunakan report engine adalah turunan dari 1 class, dimana semua instance of report object harus memberikan script (Pascal) yg otomatis akan dieksekusi oleh report-engine.

See sample, oh iya… utk ngeluarin Script-Debuger window, dikau musti tekan F9, jangan lupa select/pilih terlebih dahulu object yg ingin dilihat scriptnya.

Semua komponen visual/non visual dalam report designer/preview adalah murni buatan tangan daku. Kecuali utk script hightlight & pascal interpreter daku ambil dari free/opensource <lupa, pake punya siapa yaa… ntar deh diupdate xixixi>

Selamat mencoba… kita tunjukan pada dunia… saya juga bisa!!! wakakak…

Hosted by eSnips

Welcome to WordPress.com. This is your first post. Edit or delete it and start blogging!