diff --git a/applications/clipanalizer/clipanalizer.ico b/applications/clipanalizer/clipanalizer.ico new file mode 100644 index 000000000..0341321b5 Binary files /dev/null and b/applications/clipanalizer/clipanalizer.ico differ diff --git a/applications/clipanalizer/clipanalizer.lpi b/applications/clipanalizer/clipanalizer.lpi new file mode 100644 index 000000000..99c1d4492 --- /dev/null +++ b/applications/clipanalizer/clipanalizer.lpi @@ -0,0 +1,82 @@ + + + + + + + + + + <Scaled Value="True"/> + <ResourceType Value="res"/> + <UseXPManifest Value="True"/> + <XPManifest> + <DpiAware Value="True"/> + </XPManifest> + <Icon Value="0"/> + </General> + <BuildModes Count="1"> + <Item1 Name="Default" Default="True"/> + </BuildModes> + <PublishOptions> + <Version Value="2"/> + </PublishOptions> + <RunParams> + <FormatVersion Value="2"/> + <Modes Count="0"/> + </RunParams> + <RequiredPackages Count="1"> + <Item1> + <PackageName Value="LCL"/> + </Item1> + </RequiredPackages> + <Units Count="3"> + <Unit0> + <Filename Value="clipanalizer.lpr"/> + <IsPartOfProject Value="True"/> + </Unit0> + <Unit1> + <Filename Value="main.pas"/> + <IsPartOfProject Value="True"/> + <ComponentName Value="frmClipboardAnalizer"/> + <HasResources Value="True"/> + <ResourceBaseClass Value="Form"/> + </Unit1> + <Unit2> + <Filename Value="ownclip.pas"/> + <IsPartOfProject Value="True"/> + </Unit2> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="11"/> + <PathDelim Value="\"/> + <Target> + <Filename Value="clipanalizer"/> + </Target> + <SearchPaths> + <IncludeFiles Value="$(ProjOutDir)"/> + <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> + </SearchPaths> + <Linking> + <Options> + <Win32> + <GraphicApplication Value="True"/> + </Win32> + </Options> + </Linking> + </CompilerOptions> + <Debugging> + <Exceptions Count="3"> + <Item1> + <Name Value="EAbort"/> + </Item1> + <Item2> + <Name Value="ECodetoolError"/> + </Item2> + <Item3> + <Name Value="EFOpenError"/> + </Item3> + </Exceptions> + </Debugging> +</CONFIG> diff --git a/applications/clipanalizer/clipanalizer.lpr b/applications/clipanalizer/clipanalizer.lpr new file mode 100644 index 000000000..8d16c92b1 --- /dev/null +++ b/applications/clipanalizer/clipanalizer.lpr @@ -0,0 +1,22 @@ +program clipanalizer; + +{$mode objfpc}{$H+} + +uses + {$IFDEF UNIX}{$IFDEF UseCThreads} + cthreads, + {$ENDIF}{$ENDIF} + Interfaces, // this includes the LCL widgetset + Forms, main, ownclip + { you can add units after this }; + +{$R *.res} + +begin + RequireDerivedFormResource := True; + Application.Scaled := True; + Application.Initialize; + Application.CreateForm(TfrmClipboardAnalizer, frmClipboardAnalizer); + Application.Run; +end. + diff --git a/applications/clipanalizer/clipanalizer.res b/applications/clipanalizer/clipanalizer.res new file mode 100644 index 000000000..1adb0406c Binary files /dev/null and b/applications/clipanalizer/clipanalizer.res differ diff --git a/applications/clipanalizer/main.lfm b/applications/clipanalizer/main.lfm new file mode 100644 index 000000000..f073ea8b9 --- /dev/null +++ b/applications/clipanalizer/main.lfm @@ -0,0 +1,199 @@ +object frmClipboardAnalizer: TfrmClipboardAnalizer + Left = 175 + Height = 517 + Top = 185 + Width = 771 + Caption = 'Clipboard Analizer' + ClientHeight = 517 + ClientWidth = 771 + LCLVersion = '1.9.0.0' + object lstTypes: TListBox + Left = 0 + Height = 517 + Top = 0 + Width = 272 + Align = alLeft + ItemHeight = 0 + OnSelectionChange = lstTypesSelectionChange + ScrollWidth = 270 + TabOrder = 0 + end + object Panel1: TPanel + Left = 277 + Height = 517 + Top = 0 + Width = 494 + Align = alClient + Caption = 'Panel1' + ClientHeight = 517 + ClientWidth = 494 + TabOrder = 1 + object Panel2: TPanel + Left = 1 + Height = 111 + Top = 1 + Width = 492 + Align = alTop + ClientHeight = 111 + ClientWidth = 492 + TabOrder = 0 + object btnUpdate: TButton + Left = 8 + Height = 25 + Top = 5 + Width = 94 + Caption = 'Load Clipboard' + OnClick = btnUpdateClick + TabOrder = 0 + end + object lblSize: TLabel + Left = 8 + Height = 15 + Top = 72 + Width = 33 + Caption = 'lblSize' + ParentColor = False + end + object chkBinText: TCheckBox + Left = 344 + Height = 19 + Top = 88 + Width = 118 + Caption = 'View Special Chars' + OnClick = chkBinTextClick + TabOrder = 1 + end + object lblEncoding: TLabel + Left = 120 + Height = 15 + Top = 72 + Width = 63 + Caption = 'lblEncoding' + ParentColor = False + end + object radAsText: TRadioButton + Left = 8 + Height = 19 + Top = 88 + Width = 77 + Caption = 'clip.AsText' + OnClick = chkBinTextClick + TabOrder = 4 + end + object radStream: TRadioButton + Left = 96 + Height = 19 + Top = 88 + Width = 57 + Caption = 'Stream' + Checked = True + OnClick = chkBinTextClick + TabOrder = 2 + TabStop = True + end + object radEncoding: TRadioButton + Left = 168 + Height = 19 + Top = 88 + Width = 70 + Caption = 'Encoding' + OnClick = chkBinTextClick + TabOrder = 3 + end + object radHex: TRadioButton + Left = 256 + Height = 19 + Top = 88 + Width = 40 + Caption = 'Hex' + OnClick = chkBinTextClick + TabOrder = 5 + end + object txtFormat: TEdit + Left = 112 + Height = 23 + Top = 5 + Width = 375 + Anchors = [akTop, akLeft, akRight] + ReadOnly = True + TabOrder = 6 + end + object btnSave: TButton + Left = 8 + Height = 25 + Top = 40 + Width = 75 + Caption = 'Save' + OnClick = btnSaveClick + TabOrder = 7 + end + object btnIsolate: TButton + Left = 272 + Height = 25 + Top = 40 + Width = 91 + Caption = 'Isolate Format' + OnClick = btnIsolateClick + TabOrder = 8 + end + object btnUpdateIsolate: TButton + Left = 368 + Height = 25 + Top = 40 + Width = 107 + Caption = 'Update && Isolate' + OnClick = btnUpdateIsolateClick + TabOrder = 9 + end + object btnOpen: TButton + Left = 89 + Height = 25 + Top = 40 + Width = 75 + Caption = 'Open' + OnClick = btnOpenClick + TabOrder = 10 + end + object btnReOpen: TButton + Left = 168 + Height = 25 + Top = 40 + Width = 75 + Caption = 'Re-Open' + OnClick = btnReOpenClick + TabOrder = 11 + end + end + object memoDump: TMemo + Left = 1 + Height = 404 + Top = 112 + Width = 492 + Align = alClient + Font.Height = -11 + Font.Name = 'Courier New' + ParentFont = False + ScrollBars = ssAutoBoth + TabOrder = 1 + WordWrap = False + end + end + object Splitter1: TSplitter + Left = 272 + Height = 517 + Top = 0 + Width = 5 + end + object sDlg: TSaveDialog + DefaultExt = '.raw' + Filter = 'Arhivos RAW|*.raw' + Left = 624 + Top = 64 + end + object oDlg: TOpenDialog + DefaultExt = '.raw' + Filter = 'Archivos Raw|*.raw|Todos los archivos|*.*' + Left = 584 + Top = 64 + end +end diff --git a/applications/clipanalizer/main.pas b/applications/clipanalizer/main.pas new file mode 100644 index 000000000..25b687c8c --- /dev/null +++ b/applications/clipanalizer/main.pas @@ -0,0 +1,417 @@ +{ ClipAnalizer: A tool for analizing the clipboard + + Copyright (C) 2018 Jesus Reyes Aguilar <jesusrmx@gmail.com> + + This library is free software; you can redistribute it and/or modify it + under the terms of the GNU Library General Public License as published by + the Free Software Foundation; either version 2 of the License, or (at your + option) any later version with the following modification: + + As a special exception, the copyright holders of this library give you + permission to link this library with independent modules to produce an + executable, regardless of the license terms of these independent modules,and + to copy and distribute the resulting executable under terms of your choice, + provided that you also meet, for each linked independent module, the terms + and conditions of the license of that module. An independent module is a + module which is not derived from or based on this library. If you modify + this library, you may extend this exception to your version of the library, + but you are not obligated to do so. If you do not wish to do so, delete this + exception statement from your version. + + This program is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or + FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License + for more details. + + You should have received a copy of the GNU Library General Public License + along with this library; if not, write to the Free Software Foundation, + Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA. +} + + +unit main; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, LCLType, LCLIntf, LConvEncoding, + Clipbrd, Forms, Controls, Graphics, Dialogs, + LCLProc, StdCtrls, ExtCtrls, Menus, OwnClip; + +type + + THexDumpOpts = set of (dopOffsetHex, dopOffsetDec); + + + { TfrmClipboardAnalizer } + + TfrmClipboardAnalizer = class(TForm) + btnReOpen: TButton; + btnUpdate: TButton; + btnSave: TButton; + btnIsolate: TButton; + btnUpdateIsolate: TButton; + btnOpen: TButton; + chkBinText: TCheckBox; + oDlg: TOpenDialog; + sDlg: TSaveDialog; + txtFormat: TEdit; + lblSize: TLabel; + lblEncoding: TLabel; + lstTypes: TListBox; + memoDump: TMemo; + Panel1: TPanel; + Panel2: TPanel; + radAsText: TRadioButton; + radHex: TRadioButton; + radStream: TRadioButton; + radEncoding: TRadioButton; + Splitter1: TSplitter; + procedure btnOpenClick(Sender: TObject); + procedure btnUpdateIsolateClick(Sender: TObject); + procedure btnSaveClick(Sender: TObject); + procedure btnIsolateClick(Sender: TObject); + procedure btnReOpenClick(Sender: TObject); + procedure btnUpdateClick(Sender: TObject); + procedure chkBinTextClick(Sender: TObject); + procedure lstTypesSelectionChange(Sender: TObject; User: boolean); + private + fFilename: string; + procedure DumpClipboard; + procedure UpdateFormatList; + public + + end; + +var + frmClipboardAnalizer: TfrmClipboardAnalizer; + +implementation + +{$R *.lfm} + +// ref: https://stackoverflow.com/questions/6304896/hex-view-of-a-file +procedure HexDump(data: pointer; size: Integer; Lines: TStrings; opt:THexDumpOpts=[]); +const + SEPHEX=' '; + SEPASC=' '; + NONASC='.'; +var + i : Integer; + hexDat, ascDat : string; + buff : PByte; + L: TStringList; + + procedure OutputStr(s:string); + begin + if Lines<>nil then begin + L.Add(s); + //s := ConvertEncoding(s, EncodingAnsi, EncodingUTF8); + //Lines.Add(s) + end + else + WriteLn(s); + end; + + function OffsetStr(offset: Integer): string; + begin + result := ''; + if [dopOffsetHex, dopOffsetDec]*Opt=[] then + exit; + if dopOffsetHex in Opt then + Result:=Result + format('%.8x: ',[Offset]); + if dopOffsetDec in Opt then + Result:=Result + format('%.8d: ',[Offset]); + end; + +begin + L := TStringList.Create; + hexDat:=OffsetStr(0); + ascDat:=''; + buff := data; + for i:=0 to size-1 do begin + hexDat := hexDat + IntToHex(buff[i], 2); + if ((buff[i]>31) and (buff[i]<128)) then + ascDat := ascDat + Char(buff[i]) + else + ascDat := ascDat + NONASC; + + if (((i+1) mod 16)<>0) and (((i+1) mod 8)=0) then + hexDat:=hexDat + SEPHEX; + + if ((i+1) mod 16)=0 then begin + OutputStr(hexdat+SEPASC+ascdat); + hexdat:=OffsetStr(i+1); + ascdat:=''; + end; + end; + + if (size mod 16)<>0 then + begin + if (size mod 16)<8 then + hexDat := hexDat+StringOfChar(' ',(8-(size mod 8))*2) + +SEPHEX+StringOfChar(' ',16) + else + hexDat := hexDat+StringOfChar(' ',(16-(size mod 16))*2); + OutputStr(hexDat + SEPASC + ascDat); + end; + if Lines<>nil then + Lines.Assign(L); + L.Free; +end; + +// ref: https://www.codeproject.com/Reference/1091137/Windows-Clipboard-Formatss +function FormatIDToStr(formatID: TClipboardFormat):string; +begin + case formatID of + 1: result := 'CF_TEXT'; // (1) ANSI text Text. + 2: result := 'CF_BITMAP'; // (2) HBITMAP Handle to a bitmap (GDI object). + 3: result := 'CF_METAFILEPICT'; // (3) METAFILEPICT Windows-Format Metafiles picture. + 4: result := 'CF_SYLK'; // (4) ANSI text Microsoft Symbolic Link [Wikipedia]. + 5: result := 'CF_DIF'; // (5) ASCII text Software Arts Data Interchange Format [Wikipedia]. + 6: result := 'CF_TIFF'; // (6) TIFF [Wikipedia] TIFF image. + 7: result := 'CF_OEMTEXT'; // (7) 8-Bit DOS text Text. + 8: result := 'CF_DIB'; // (8) BITMAPINFO Structure followed by bitmap bits. + 9: result := 'CF_PALETTE'; // (9) HPALETTE Handle to a color palette (GDI object). + 10: result := 'CF_PENDATA'; // (10) - Windows 3.1 pen extension data. + 11: result := 'CF_RIFF'; // (11) RIFF Resource Interchange File Format (RIFF) audio. + 12: result := 'CF_WAVE'; // (12) WAVE WAVE audio. + 13: result := 'CF_UNICODETEXT'; // (13) Unicode text Text. + 14: result := 'CF_ENHMETAFILE'; // (14) HENHMETAFILE Enhanced-Format Metafiles handle. + 15: result := 'CF_HDROP'; // (15) DROPFILES List of file names. + 16: result := 'CF_LOCALE'; // (16) DWORD (LCID) LCID for CF_TEXT to CF_UNICODE conversion. + 17: result := 'CF_DIBV5'; // (17) BITMAPV5HEADER Structure followed by bitmap bits + $0081: result := 'CF_DSPTEXT'; // (0x0081) ANSI text Text. + $0082: result := 'CF_DSPBITMAP'; // (0x0082) HBITMAP Handle to a bitmap (GDI object) + $0083: result := 'CF_DSPMETAFILEPICT'; // (0x0083) METAFILEPICT Windows-Format Metafiles picture. + $0084: result := 'CF_DSPENHMETAFILE'; // (0x008E) HENHMETAFILE Enhanced-Format Metafiles handle. + else begin + result := ''; + end; + end; +end; + +function FormatIDIsText(formatID:TClipboardFormat): boolean; +begin + case formatID of + 1,4,5,7, + 49291: + result := true; + else + result := false; + end; +end; + +{ TfrmClipboardAnalizer } + +procedure TfrmClipboardAnalizer.btnUpdateClick(Sender: TObject); +begin + UpdateFormatList; +end; + +procedure TfrmClipboardAnalizer.btnSaveClick(Sender: TObject); +var + aIndex: Integer; + formatID: TClipboardFormat; + stream: TMemoryStream; +begin + aIndex := lstTypes.ItemIndex; + if aIndex<0 then + exit; + + if not sDlg.Execute then + exit; + + formatID := TClipboardFormat(lstTypes.Items.Objects[aIndex]); + + stream := TMemoryStream.Create; + try + ClipboardGetFormat(formatID, stream); + stream.position := 0; + + stream.SaveToFile(sDlg.FileName); + + finally + stream.free; + end; +end; + +procedure TfrmClipboardAnalizer.btnUpdateIsolateClick(Sender: TObject); +var + aIndex: Integer; + formatID: TClipboardFormat; + stream: TMemoryStream; +begin + aIndex := lstTypes.ItemIndex; + if aIndex<0 then + exit; + + formatID := TClipboardFormat(lstTypes.Items.Objects[aIndex]); + + stream := TMemoryStream.Create; + try + memoDump.Lines.SaveToStream(stream); + stream.position := 0; + + Clipboard.Open; + Clipboard.Clear; + Clipboard.AddFormat(formatID, stream); + Clipboard.Close; + + UpdateFormatList; + finally + stream.free; + end; +end; + +procedure TfrmClipboardAnalizer.btnOpenClick(Sender: TObject); +begin + if oDlg.Execute then begin + fFilename := oDlg.Filename; + memoDump.Lines.LoadFromFile(oDlg.FileName); + end; +end; + +procedure TfrmClipboardAnalizer.btnIsolateClick(Sender: TObject); +var + aIndex: Integer; + formatID: TClipboardFormat; + stream: TMemoryStream; +begin + aIndex := lstTypes.ItemIndex; + if aIndex<0 then + exit; + + formatID := TClipboardFormat(lstTypes.Items.Objects[aIndex]); + + stream := TMemoryStream.Create; + try + ClipboardGetFormat(formatID, stream); + stream.position := 0; + + Clipboard.Open; + Clipboard.Clear; + Clipboard.AddFormat(formatID, stream); + Clipboard.Close; + + UpdateFormatList; + finally + stream.free; + end; +end; + +procedure TfrmClipboardAnalizer.btnReOpenClick(Sender: TObject); +begin + if fFilename='' then + btnOpenClick(Self) + else + memoDump.Lines.LoadFromFile(fFilename); +end; + +procedure TfrmClipboardAnalizer.chkBinTextClick(Sender: TObject); +begin + if lstTypes.ItemIndex>=0 then + DumpClipboard; +end; + +procedure TfrmClipboardAnalizer.lstTypesSelectionChange(Sender: TObject; User: boolean); +begin + DumpClipboard; +end; + +procedure TfrmClipboardAnalizer.DumpClipboard; +var + formatID: TClipboardFormat; + stream: TMemoryStream; + isText: Boolean; + s: RawByteString; + encodingStr: string; + aIndex: Integer; + + procedure ProcessBin; + var + i: Integer; + begin + if chkBinText.Checked then + for i:=0 to memoDump.Lines.Count-1 do begin + memoDump.Lines[i] := DbgStr(memoDump.Lines[i]); + end; + end; + +begin + aIndex := lstTypes.ItemIndex; + if aIndex<0 then begin + memoDump.Clear; + exit; + end; + formatID := TClipboardFormat(lstTypes.Items.Objects[aIndex]); + isText := FormatIDIsText(formatID); + + stream := TMemoryStream.Create; + try + memoDump.Lines.BeginUpdate; + + ClipboardGetFormat(formatID, stream); + stream.position := 0; + SetString(s, stream.Memory, stream.Size); + encodingStr := GuessEncoding(s); + if formatID=13{CF_UNICODETEXT} then + encodingStr := EncodingUCS2LE; + + txtFormat.Text := lstTypes.Items[aIndex]; + lblEncoding.Caption := encodingStr; + lblSize.Caption := format('%d bytes',[stream.size]); + + if radHex.Checked then begin + HexDump(stream.Memory, stream.Size, memoDump.Lines, [dopOffsetHex]); + exit; + end; + + if radAsText.checked then + memoDump.Text := Clipboard.AsText + else + if radStream.Checked then + memoDump.Lines.LoadFromStream(stream{, True}) + else begin + if encodingStr=EncodingUTF8 then + memoDump.Text := s + else + memoDump.Text := ConvertEncoding(s, encodingStr, EncodingUTF8); + end; + + ProcessBin; + + finally + stream.Free; + memoDump.Lines.EndUpdate; + end; +end; + +procedure TfrmClipboardAnalizer.UpdateFormatList; +var + L: TStringList; + formatID: TClipboardFormat; + i: Integer; +begin + L := TStringList.Create; + + for i := 0 to Clipboard.FormatCount - 1 do begin + formatID := Clipboard.Formats[i]; + if formatID = 0 then + continue; + L.AddObject( + format('%d:%s:%s', [ + FormatID, + FormatIDToStr(FormatID), + ClipboardFormatToMimeType(FormatID)]), + TObject(PtrUInt(formatID))); + end; + lstTypes.Items.Assign(L); + + L.Free; +end; + +end. + diff --git a/applications/clipanalizer/ownclip.pas b/applications/clipanalizer/ownclip.pas new file mode 100644 index 000000000..2876a81ef --- /dev/null +++ b/applications/clipanalizer/ownclip.pas @@ -0,0 +1,64 @@ +unit ownclip; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils + {$ifdef MSWINDOWS} + , Windows; + {$else} + , LCLType, LCLIntf; + {$endif} + + function ClipboardGetFormat(formatID: UINT; DestStream: TStream): boolean; + +implementation + +function ClipboardGetFormat(formatID: UINT; DestStream: TStream): boolean; +{$ifdef MSWINDOWS} +var + DataHandle: HANDLE; + ASize: PtrUInt; + Data: LPVOID; +begin + + // borrowed from Lazarus clipboard support .. + + result := false; + + if (FormatID=0) or (DestStream=nil) or + not Windows.IsClipboardFormatAvailable(FormatID) then exit; + + if Windows.OpenClipboard(Windows.HWND(nil)) then + try + + DataHandle := Windows.GetClipboardData(FormatID); + if DataHandle<>HWND(0) then + begin + ASize := Windows.GlobalSize(DataHandle); + if ASize>0 then + begin + Data := Windows.GlobalLock(DataHandle); + try + DestStream.Write(Data^, ASize); + finally + Windows.GlobalUnlock(DataHandle); + end; + Result := true; + end; + end; + finally + Windows.CloseClipboard; + end; +end; +{$else} +begin + ClipboardGetData(ctPrimarySelection, formatID, DestStream); +end; + +{$endif} + +end. +