| /Recycle Bin Unit/ShellState Analyse.txt |
|---|
| 1,42 → 1,40 |
| Dialogfeld zur Bestätigung einblenden |
| HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\ShellState [Byte 5] |
| Analyse bei verschiedenen Betriebssystemen |
| Analysis of "Recycler confirm dialog" setting |
| Analysis of Byte #5 of |
| HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\ShellState |
| => Mittlerweile durch ShellAPI abgelöst |
| [ ] Unchecked |
| [X] Checked |
| [X]1st Checked and never changed settings of recycler |
| ------------------ |
| Windows 95b ohne IE4 |
| ShGetSettings: NOT EXISTING! |
| [ ] 05h 0 0 0 0 0[1]0 1 |
| [X] 01h 0 0 0 0 0[0]0 1 |
| [X]1st ? ? |
| Nach Änderungen Bei Auslieferung |
| [ ] [X] [ ] [X] |
| Win95b 05 01 |
| Win2k 25 21 |
| WinXP 35 31 |
| Win2k3 3a 3e 33 |
| Windows 2000 Professional |
| ShGetSettings: OK |
| [ ] 25h 0 0 1 0 0[1]0 1 |
| [X] 21h 0 0 1 0 0[0]0 1 |
| [X]1st 20h 0 0 1 0 0[0]0 0 |
| ------------------ |
| Windows 2000 Professional (Some other Settings!) |
| ShGetSettings: OK |
| [ ] 65h 0 1 1 0 0[1]0 1 |
| [X] 61h 0 1 1 0 0[0]0 1 |
| Windows Server 2003 EE SP1 |
| 3 Drives, Dialogfeld ausblenden |
| 24,00,00,00,3e,08,00,00,00,00,00,00,00,00,00,00,00,00,00,00,01,00,00,00,0d,00,00,00,00,00,00,00,02,00,00,00 |
| Windows XP |
| ShGetSettings: OK |
| [ ] 35h 0 0 1 1 0[1]0 1 |
| [X] 31h 0 0 1 1 0[0]0 1 |
| [X]1st 30h 0 0 1 1 0[0]0 0 |
| Windows Server 2003 EE SP1 |
| 3 Drives, Dialogfeld einblenden |
| 24,00,00,00,3a,08,00,00,00,00,00,00,00,00,00,00,00,00,00,00,01,00,00,00,0d,00,00,00,00,00,00,00,02,00,00,00 |
| Windows 2003 Server EE, SP1 |
| ShGetSettings: OK |
| [ ] 3Ah 0 0 1 1 1[0]1 0 (???) |
| [X] 3Eh 0 0 1 1 1[1]1 0 (???) |
| [X]1st 33h 0 0 1 1 0[0]1 1 |
| ------------------ |
| Windows 95b |
| 1 Drive |
| [ ] Dialogfeld zur Bestätigung einblenden |
| 10 00 00 00 05 00 00 00 00 00 00 00 00 00 00 00 |
| [X] Dialogfeld zur Bestätigung einblenden |
| 10 00 00 00 01 00 00 00 00 00 00 00 00 00 00 00 |
| In Windows 2000: statt 05 und 01 sind die Bytes 25 und 21... |
| In Windows XP: statt 05 und 01 sind die Bytes 35 und 31... |
| Aber: Wenn der Wert noch niemals geändert wurde, ist er 20 und 30 |
| anstelle von 21 und 31! |
| http://www.msfn.org/board/single-shellstate-disable-recycle-delete-conf-t122649.html |
| [ ] 2Ah 0 0 1 0 1[0]1 0 |
| [X] 2Eh 0 0 1 0 1[1]1 0 |
| /Create Shortcut/Shortcut.dpr |
|---|
| 0,0 → 1,53 |
| program Shortcut; |
| {$APPTYPE CONSOLE} |
| uses |
| SysUtils, ShlObj, ActiveX, ComObj, Windows; |
| // http://www.delphi-library.de/viewtopic.php?t=20516 |
| function ExpandEnvStr(const szInput: string): string; |
| const |
| MAXSIZE = 32768; // laut PSDK sind 32k das Maximum |
| begin |
| SetLength(Result, MAXSIZE); |
| SetLength(Result, ExpandEnvironmentStrings(pchar(szInput), |
| @Result[1],length(Result))-1); //-1 um abschließendes #0 zu verwerfen |
| end; |
| var |
| IObject : IUnknown; |
| ISLink : IShellLink; |
| IPFile : IPersistFile; |
| TargetName : String; |
| LinkName : WideString; |
| // Ref: http://delphi.about.com/od/windowsshellapi/a/create_lnk.htm |
| begin |
| If ParamCount <> 2 then |
| begin |
| WriteLn('Usage: SHORTCUT.EXE <source> <dest>'); |
| WriteLn(''); |
| end |
| else |
| begin |
| CoInitialize(nil); |
| TargetName := ExpandEnvStr(ParamStr(1)); |
| IObject := CreateComObject(CLSID_ShellLink); |
| ISLink := IObject as IShellLink; |
| IPFile := IObject as IPersistFile; |
| with ISLink do |
| begin |
| SetPath(pChar(TargetName)) ; |
| SetWorkingDirectory(pChar(ExtractFilePath(TargetName))) ; |
| end; |
| LinkName := ExpandEnvStr(ParamStr(2)); |
| IPFile.Save(PWChar(LinkName), false); |
| CoUninitialize; |
| end; |
| end. |
| /Create Shortcut/Shortcut.cfg |
|---|
| 0,0 → 1,38 |
| -$A8 |
| -$B- |
| -$C+ |
| -$D+ |
| -$E- |
| -$F- |
| -$G+ |
| -$H+ |
| -$I+ |
| -$J- |
| -$K- |
| -$L+ |
| -$M- |
| -$N+ |
| -$O+ |
| -$P+ |
| -$Q- |
| -$R- |
| -$S- |
| -$T- |
| -$U- |
| -$V+ |
| -$W- |
| -$X+ |
| -$YD |
| -$Z1 |
| -cg |
| -AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; |
| -H+ |
| -W+ |
| -M |
| -$M16384,1048576 |
| -K$00400000 |
| -LE"C:\Dokumente und Einstellungen\Daniel Marschall\Eigene Dateien\Borland Studio-Projekte\Bpl" |
| -LN"C:\Dokumente und Einstellungen\Daniel Marschall\Eigene Dateien\Borland Studio-Projekte\Bpl" |
| -w-UNSAFE_TYPE |
| -w-UNSAFE_CODE |
| -w-UNSAFE_CAST |
| /Create Shortcut/Shortcut.exe |
|---|
| Cannot display: file marked as a binary type. |
| svn:mime-type = application/octet-stream |
| Property changes: |
| Added: svn:mime-type |
| +application/octet-stream |
| \ No newline at end of property |
| /Create Shortcut/Shortcut.bdsproj |
|---|
| 0,0 → 1,175 |
| <?xml version="1.0" encoding="utf-8"?> |
| <BorlandProject> |
| <PersonalityInfo> |
| <Option> |
| <Option Name="Personality">Delphi.Personality</Option> |
| <Option Name="ProjectType"></Option> |
| <Option Name="Version">1.0</Option> |
| <Option Name="GUID">{6C2B34AE-708E-4B24-9E94-764B14CBF435}</Option> |
| </Option> |
| </PersonalityInfo> |
| <Delphi.Personality> |
| <Source> |
| <Source Name="MainSource">Shortcut.dpr</Source> |
| </Source> |
| <FileVersion> |
| <FileVersion Name="Version">7.0</FileVersion> |
| </FileVersion> |
| <Compiler> |
| <Compiler Name="A">8</Compiler> |
| <Compiler Name="B">0</Compiler> |
| <Compiler Name="C">1</Compiler> |
| <Compiler Name="D">1</Compiler> |
| <Compiler Name="E">0</Compiler> |
| <Compiler Name="F">0</Compiler> |
| <Compiler Name="G">1</Compiler> |
| <Compiler Name="H">1</Compiler> |
| <Compiler Name="I">1</Compiler> |
| <Compiler Name="J">0</Compiler> |
| <Compiler Name="K">0</Compiler> |
| <Compiler Name="L">1</Compiler> |
| <Compiler Name="M">0</Compiler> |
| <Compiler Name="N">1</Compiler> |
| <Compiler Name="O">1</Compiler> |
| <Compiler Name="P">1</Compiler> |
| <Compiler Name="Q">0</Compiler> |
| <Compiler Name="R">0</Compiler> |
| <Compiler Name="S">0</Compiler> |
| <Compiler Name="T">0</Compiler> |
| <Compiler Name="U">0</Compiler> |
| <Compiler Name="V">1</Compiler> |
| <Compiler Name="W">0</Compiler> |
| <Compiler Name="X">1</Compiler> |
| <Compiler Name="Y">1</Compiler> |
| <Compiler Name="Z">1</Compiler> |
| <Compiler Name="ShowHints">True</Compiler> |
| <Compiler Name="ShowWarnings">True</Compiler> |
| <Compiler Name="UnitAliases">WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;</Compiler> |
| <Compiler Name="NamespacePrefix"></Compiler> |
| <Compiler Name="GenerateDocumentation">False</Compiler> |
| <Compiler Name="DefaultNamespace"></Compiler> |
| <Compiler Name="SymbolDeprecated">True</Compiler> |
| <Compiler Name="SymbolLibrary">True</Compiler> |
| <Compiler Name="SymbolPlatform">True</Compiler> |
| <Compiler Name="SymbolExperimental">True</Compiler> |
| <Compiler Name="UnitLibrary">True</Compiler> |
| <Compiler Name="UnitPlatform">True</Compiler> |
| <Compiler Name="UnitDeprecated">True</Compiler> |
| <Compiler Name="UnitExperimental">True</Compiler> |
| <Compiler Name="HResultCompat">True</Compiler> |
| <Compiler Name="HidingMember">True</Compiler> |
| <Compiler Name="HiddenVirtual">True</Compiler> |
| <Compiler Name="Garbage">True</Compiler> |
| <Compiler Name="BoundsError">True</Compiler> |
| <Compiler Name="ZeroNilCompat">True</Compiler> |
| <Compiler Name="StringConstTruncated">True</Compiler> |
| <Compiler Name="ForLoopVarVarPar">True</Compiler> |
| <Compiler Name="TypedConstVarPar">True</Compiler> |
| <Compiler Name="AsgToTypedConst">True</Compiler> |
| <Compiler Name="CaseLabelRange">True</Compiler> |
| <Compiler Name="ForVariable">True</Compiler> |
| <Compiler Name="ConstructingAbstract">True</Compiler> |
| <Compiler Name="ComparisonFalse">True</Compiler> |
| <Compiler Name="ComparisonTrue">True</Compiler> |
| <Compiler Name="ComparingSignedUnsigned">True</Compiler> |
| <Compiler Name="CombiningSignedUnsigned">True</Compiler> |
| <Compiler Name="UnsupportedConstruct">True</Compiler> |
| <Compiler Name="FileOpen">True</Compiler> |
| <Compiler Name="FileOpenUnitSrc">True</Compiler> |
| <Compiler Name="BadGlobalSymbol">True</Compiler> |
| <Compiler Name="DuplicateConstructorDestructor">True</Compiler> |
| <Compiler Name="InvalidDirective">True</Compiler> |
| <Compiler Name="PackageNoLink">True</Compiler> |
| <Compiler Name="PackageThreadVar">True</Compiler> |
| <Compiler Name="ImplicitImport">True</Compiler> |
| <Compiler Name="HPPEMITIgnored">True</Compiler> |
| <Compiler Name="NoRetVal">True</Compiler> |
| <Compiler Name="UseBeforeDef">True</Compiler> |
| <Compiler Name="ForLoopVarUndef">True</Compiler> |
| <Compiler Name="UnitNameMismatch">True</Compiler> |
| <Compiler Name="NoCFGFileFound">True</Compiler> |
| <Compiler Name="ImplicitVariants">True</Compiler> |
| <Compiler Name="UnicodeToLocale">True</Compiler> |
| <Compiler Name="LocaleToUnicode">True</Compiler> |
| <Compiler Name="ImagebaseMultiple">True</Compiler> |
| <Compiler Name="SuspiciousTypecast">True</Compiler> |
| <Compiler Name="PrivatePropAccessor">True</Compiler> |
| <Compiler Name="UnsafeType">False</Compiler> |
| <Compiler Name="UnsafeCode">False</Compiler> |
| <Compiler Name="UnsafeCast">False</Compiler> |
| <Compiler Name="OptionTruncated">True</Compiler> |
| <Compiler Name="WideCharReduced">True</Compiler> |
| <Compiler Name="DuplicatesIgnored">True</Compiler> |
| <Compiler Name="UnitInitSeq">True</Compiler> |
| <Compiler Name="LocalPInvoke">True</Compiler> |
| <Compiler Name="MessageDirective">True</Compiler> |
| <Compiler Name="CodePage"></Compiler> |
| </Compiler> |
| <Linker> |
| <Linker Name="MapFile">0</Linker> |
| <Linker Name="OutputObjs">0</Linker> |
| <Linker Name="GenerateHpps">False</Linker> |
| <Linker Name="ConsoleApp">1</Linker> |
| <Linker Name="DebugInfo">False</Linker> |
| <Linker Name="RemoteSymbols">False</Linker> |
| <Linker Name="GenerateDRC">False</Linker> |
| <Linker Name="MinStackSize">16384</Linker> |
| <Linker Name="MaxStackSize">1048576</Linker> |
| <Linker Name="ImageBase">4194304</Linker> |
| <Linker Name="ExeDescription"></Linker> |
| </Linker> |
| <Directories> |
| <Directories Name="OutputDir"></Directories> |
| <Directories Name="UnitOutputDir"></Directories> |
| <Directories Name="PackageDLLOutputDir"></Directories> |
| <Directories Name="PackageDCPOutputDir"></Directories> |
| <Directories Name="SearchPath"></Directories> |
| <Directories Name="Packages"></Directories> |
| <Directories Name="Conditionals"></Directories> |
| <Directories Name="DebugSourceDirs"></Directories> |
| <Directories Name="UsePackages">False</Directories> |
| </Directories> |
| <Parameters> |
| <Parameters Name="RunParams"></Parameters> |
| <Parameters Name="HostApplication"></Parameters> |
| <Parameters Name="Launcher"></Parameters> |
| <Parameters Name="UseLauncher">False</Parameters> |
| <Parameters Name="DebugCWD"></Parameters> |
| <Parameters Name="Debug Symbols Search Path"></Parameters> |
| <Parameters Name="LoadAllSymbols">True</Parameters> |
| <Parameters Name="LoadUnspecifiedSymbols">False</Parameters> |
| </Parameters> |
| <Language> |
| <Language Name="ActiveLang"></Language> |
| <Language Name="ProjectLang">$00000000</Language> |
| <Language Name="RootDir"></Language> |
| </Language> |
| <VersionInfo> |
| <VersionInfo Name="IncludeVerInfo">False</VersionInfo> |
| <VersionInfo Name="AutoIncBuild">False</VersionInfo> |
| <VersionInfo Name="MajorVer">1</VersionInfo> |
| <VersionInfo Name="MinorVer">0</VersionInfo> |
| <VersionInfo Name="Release">0</VersionInfo> |
| <VersionInfo Name="Build">0</VersionInfo> |
| <VersionInfo Name="Debug">False</VersionInfo> |
| <VersionInfo Name="PreRelease">False</VersionInfo> |
| <VersionInfo Name="Special">False</VersionInfo> |
| <VersionInfo Name="Private">False</VersionInfo> |
| <VersionInfo Name="DLL">False</VersionInfo> |
| <VersionInfo Name="Locale">1031</VersionInfo> |
| <VersionInfo Name="CodePage">1252</VersionInfo> |
| </VersionInfo> |
| <VersionInfoKeys> |
| <VersionInfoKeys Name="CompanyName"></VersionInfoKeys> |
| <VersionInfoKeys Name="FileDescription"></VersionInfoKeys> |
| <VersionInfoKeys Name="FileVersion">1.0.0.0</VersionInfoKeys> |
| <VersionInfoKeys Name="InternalName"></VersionInfoKeys> |
| <VersionInfoKeys Name="LegalCopyright"></VersionInfoKeys> |
| <VersionInfoKeys Name="LegalTrademarks"></VersionInfoKeys> |
| <VersionInfoKeys Name="OriginalFilename"></VersionInfoKeys> |
| <VersionInfoKeys Name="ProductName"></VersionInfoKeys> |
| <VersionInfoKeys Name="ProductVersion">1.0.0.0</VersionInfoKeys> |
| <VersionInfoKeys Name="Comments"></VersionInfoKeys> |
| </VersionInfoKeys> |
| </Delphi.Personality> |
| </BorlandProject> |
| /Batch-Working-Directory/bwd.dpr |
|---|
| 0,0 → 1,39 |
| program bwd; |
| { |
| Batch-Working-Directory |
| Executes a batch script and set the working directory to |
| the batch script's directory. |
| } |
| uses |
| ShellAPI, SysUtils, Windows; |
| {$R *.res} |
| var |
| i: integer; |
| params: string; |
| begin |
| if ParamCount() < 1 then |
| begin |
| WriteLn('Batch-Working-Directory'); |
| WriteLn('Executes a file and set the working directory to the file''s directory'); |
| WriteLn(''); |
| WriteLn('Syntax: bwd.exe application [params]'); |
| end |
| else |
| begin |
| params := ''; |
| for i := 2 to ParamCount() - 1 do |
| begin |
| params := ParamStr(i); |
| end; |
| // ToDo: In Konsole einbetten? |
| ShellExecute(0, 'open', PChar(ParamStr(1)), PChar(params), PChar(ExtractFilePath(ParamStr(1))), SW_NORMAL); |
| end; |
| end. |
| /Batch-Working-Directory/bwd.dof |
|---|
| 0,0 → 1,83 |
| [FileVersion] |
| Version=6.0 |
| [Compiler] |
| A=8 |
| B=0 |
| C=1 |
| D=1 |
| E=0 |
| F=0 |
| G=1 |
| H=1 |
| I=1 |
| J=0 |
| K=0 |
| L=1 |
| M=0 |
| N=1 |
| O=1 |
| P=1 |
| Q=0 |
| R=0 |
| S=0 |
| T=0 |
| U=0 |
| V=1 |
| W=0 |
| X=1 |
| Y=1 |
| Z=1 |
| ShowHints=1 |
| ShowWarnings=1 |
| UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; |
| [Linker] |
| MapFile=0 |
| OutputObjs=0 |
| ConsoleApp=1 |
| DebugInfo=0 |
| RemoteSymbols=0 |
| MinStackSize=16384 |
| MaxStackSize=1048576 |
| ImageBase=4194304 |
| ExeDescription= |
| [Directories] |
| OutputDir= |
| UnitOutputDir= |
| PackageDLLOutputDir= |
| PackageDCPOutputDir= |
| SearchPath= |
| Packages= |
| Conditionals= |
| DebugSourceDirs= |
| UsePackages=0 |
| [Parameters] |
| RunParams= |
| HostApplication= |
| Launcher= |
| UseLauncher=0 |
| DebugCWD= |
| [Version Info] |
| IncludeVerInfo=0 |
| AutoIncBuild=0 |
| MajorVer=1 |
| MinorVer=0 |
| Release=0 |
| Build=0 |
| Debug=0 |
| PreRelease=0 |
| Special=0 |
| Private=0 |
| DLL=0 |
| Locale=1031 |
| CodePage=1252 |
| [Version Info Keys] |
| CompanyName= |
| FileDescription= |
| FileVersion=1.0.0.0 |
| InternalName= |
| LegalCopyright= |
| LegalTrademarks= |
| OriginalFilename= |
| ProductName= |
| ProductVersion=1.0.0.0 |
| Comments= |
| /Batch-Working-Directory/bwd.res |
|---|
| Cannot display: file marked as a binary type. |
| svn:mime-type = application/octet-stream |
| Property changes: |
| Added: svn:mime-type |
| +application/octet-stream |
| \ No newline at end of property |
| /Batch-Working-Directory/bwd.cfg |
|---|
| 0,0 → 1,35 |
| -$A8 |
| -$B- |
| -$C+ |
| -$D+ |
| -$E- |
| -$F- |
| -$G+ |
| -$H+ |
| -$I+ |
| -$J- |
| -$K- |
| -$L+ |
| -$M- |
| -$N+ |
| -$O+ |
| -$P+ |
| -$Q- |
| -$R- |
| -$S- |
| -$T- |
| -$U- |
| -$V+ |
| -$W- |
| -$X+ |
| -$YD |
| -$Z1 |
| -cg |
| -AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; |
| -H+ |
| -W+ |
| -M |
| -$M16384,1048576 |
| -K$00400000 |
| -LE"c:\programme\borland\delphi6\Projects\Bpl" |
| -LN"c:\programme\borland\delphi6\Projects\Bpl" |
| /Batch-Working-Directory/bwd.exe |
|---|
| Cannot display: file marked as a binary type. |
| svn:mime-type = application/octet-stream |
| Property changes: |
| Added: svn:mime-type |
| +application/octet-stream |
| \ No newline at end of property |
| /Batch-Working-Directory/bwd.~dpr |
|---|
| 0,0 → 1,39 |
| program bwd; |
| { |
| Batch-Working-Directory |
| Executes a batch script and set the working directory to |
| the batch script's directory. |
| } |
| uses |
| ShellAPI; |
| {$R *.res} |
| var |
| i: integer; |
| params: string; |
| begin |
| if ParamCount() < 1 then |
| begin |
| WriteLn('Batch-Working-Directory'); |
| WriteLn('Executes a file and set the working directory to the file''s directory'); |
| WriteLn(''); |
| WriteLn('Syntax: bwd.exe application [params]'); |
| end |
| else |
| begin |
| params := ''; |
| for i := 2 to ParamCount() - 1 do |
| begin |
| params := ParamStr(i); |
| end; |
| // ToDo: In Konsole einbetten? |
| ShellExecute(0, 'open', ParamStr(1), PChar(params), ExtractFilePath(ParamStr(1)), SW_NORMAL); |
| end; |
| end. |
| /SmartDelphiTools.bdsgroup |
|---|
| 0,0 → 1,23 |
| <?xml version="1.0" encoding="utf-8"?> |
| <BorlandProject> |
| <PersonalityInfo> |
| <Option> |
| <Option Name="Personality">Default.Personality</Option> |
| <Option Name="ProjectType"></Option> |
| <Option Name="Version">1.0</Option> |
| <Option Name="GUID">{0DEA933B-C8E7-47BB-825E-F556DD5C9674}</Option> |
| </Option> |
| </PersonalityInfo> |
| <Default.Personality> |
| <Projects> |
| <Projects Name="Shortcut.exe">Create Shortcut\Shortcut.bdsproj</Projects> |
| <Projects Name="DosLineConv.exe">DosLineConv\DosLineConv.bdsproj</Projects> |
| <Projects Name="FileExtCh.exe">FileExtCh\FileExtCh.bdsproj</Projects> |
| <Projects Name="FileMD5.exe">FileMD5\FileMD5.bdsproj</Projects> |
| <Projects Name="Calender.exe">Kalenderersatz\Calender.bdsproj</Projects> |
| <Projects Name="Targets">Shortcut.exe DosLineConv.exe FileExtCh.exe FileMD5.exe Calender.exe</Projects> |
| </Projects> |
| <Dependencies/> |
| </Default.Personality> |
| </BorlandProject> |
| /Ideen.txt |
|---|
| 1,4 → 1,6 |
| Ein Tool, das das automatische Herunterfahren verhindert (Ausschaltbar über Benutzer) |
| Tray-Kalender für Firmen-PCs |
| FC Group Tool |
| MD5 Tool |
| "cd" das auch eine Datei annimmt (und dann in das verzeichnis springt) |
| "fc" mit Drag'n'Drop (auch mehr als 2, dann gruppieren) |
| Verzeichnis-Hash-Tool |
| /Units/BitOps.pas |
|---|
| 0,0 → 1,694 |
| unit BitOps; |
| (************************************************************* |
| BitOps.pas |
| Bit- Byte- and Nibbleoperations |
| 64 Bit Edition; Rev 21 March 2010 |
| (C) 2010 ViaThinkSoft [www.viathinksoft.com] |
| Developed by Daniel Marschall [www.daniel-marschall.de] |
| Source: |
| http://home.viathinksoft.de/daniel-marschall/code/delphi/BitOps.pas |
| *************************************************************) |
| interface |
| uses |
| SysUtils; |
| // * TYPES * |
| type |
| Nibble = 0..127; |
| THexNibble = $0..$F; |
| T4BitPos = 0..3; |
| T8BitPos = 0..7; |
| T16BitPos = 0..15; |
| T32BitPos = 0..31; |
| T64BitPos = 0..63; |
| // Maximum amount of bytes in the biggest data type (int64) |
| TBytePos = 0..7; |
| // Maximum amount of nibbles in the biggest data type (int64) |
| THexNibblePos = 0..15; |
| TBit = Boolean; |
| THexNibbleBitArray = array[Low(T4BitPos)..High(T4BitPos)] of TBit; |
| TByteBitArray = array[Low(T8BitPos)..High(T8BitPos)] of TBit; |
| TBitString = type string; |
| TByteBitString = type TBitString; |
| THexNibbleBitString = type TBitString; |
| // ****************** |
| // * BYTE FUNCTIONS * |
| // ****************** |
| // Build a byte. |
| // Either you combine two nibbles... |
| function BuildByte(AUpperNibble, ALowerNibble: THexNibble): Byte; overload; |
| // ...or you define an array of 8 bits. |
| function BuildByte(ABitArray: TByteBitArray): Byte; overload; |
| // ...or you define a bitstring (e.g. '00011100') |
| function BuildByte(ABits: TByteBitString): Byte; overload; |
| // ...or you define the bits as parameters |
| function BuildByte(ABit1, ABit2, ABit3, ABit4, ABit5, ABit6, ABit7, |
| ABit8: TBit): Byte; overload; |
| // Converts a byte into a array of 8 bits |
| function GetByteBitArray(AByte: Byte): TByteBitArray; |
| // Getting and setting the lower nibble of a byte. |
| function GetLowerNibble(AByte: Byte): THexNibble; |
| function SetLowerNibble(AByte: Byte; ANewNibble: THexNibble): Byte; |
| // Getting and setting the upper nibble of a byte. |
| function GetUpperNibble(AByte: Byte): THexNibble; |
| function SetUpperNibble(AByte: Byte; ANewNibble: THexNibble): Byte; |
| // Interchanges upper and lower Nibble in a byte |
| function InterchangeNibbles(AByte: Byte): Byte; |
| // Creates an 8-bit-array from a 8-bit-string |
| // Throws EBitStringTooLong and EBitStringInvalidCharacter |
| function ByteBitArrayFromBitString(const ABits: TByteBitString): |
| TByteBitArray; |
| // Getting and setting of a bit in a byte |
| function GetByteBit(AByte: Byte; ABitPos: T8BitPos): TBit; |
| function SetByteBit(AByte: Byte; ABitPos: T8BitPos; ANewBit: TBit): Byte; |
| // Logical operations for the 8 bit arrays. |
| function ByteBitArrayShr(ABitArray: TByteBitArray; |
| AVal: Longword): TByteBitArray; |
| function ByteBitArrayShl(ABitArray: TByteBitArray; |
| AVal: Longword): TByteBitArray; |
| function ByteBitArrayAnd(ABitArray, ABitArray2: TByteBitArray): TByteBitArray; |
| function ByteBitArrayOr(ABitArray, ABitArray2: TByteBitArray): TByteBitArray; |
| function ByteBitArrayXor(ABitArray, ABitArray2: TByteBitArray): TByteBitArray; |
| function ByteBitArrayNot(ABitArray: TByteBitArray): TByteBitArray; |
| // Inverse the bits of a byte |
| function InverseByteBits(x: Byte): Byte; |
| // Reverses the bit sequence of a byte |
| function ReverseByteBitSequence(AByte: Byte): Byte; |
| // ******************** |
| // * NIBBLE FUNCTIONS * |
| // ******************** |
| // Build a Nibble. |
| // You can define an array of 4 bits. |
| function BuildNibble(ABitArray: THexNibbleBitArray): Nibble; overload; |
| // ...or you define a bitstring (e.g. '0001') |
| function BuildNibble(ABits: THexNibbleBitString): Nibble; overload; |
| // ...or you define the bits as parameters |
| function BuildNibble(ABit1, ABit2, ABit3, ABit4: TBit): Nibble; overload; |
| // Converts a nibble into a array of 4 bits |
| function GetNibbleBitArray(ANibble: Nibble): THexNibbleBitArray; |
| // Creates an 4-bit-array from a 4-bit-string |
| // Throws EBitStringTooLong and EBitStringInvalidCharacter |
| function NibbleBitArrayFromBitString(const ABits: THexNibbleBitString): |
| THexNibbleBitArray; |
| // Getting and setting of a bit in a nibble |
| function GetNibbleBit(ANibble: Nibble; ABitPos: T4BitPos): TBit; |
| function SetNibbleBit(ANibble: Nibble; ABitPos: T4BitPos; |
| ANewBit: TBit): Nibble; |
| // Logical operations for the 4 bit arrays. |
| function NibbleBitArrayShr(ABitArray: THexNibbleBitArray; AVal: Longword): |
| THexNibbleBitArray; |
| function NibbleBitArrayShl(ABitArray: THexNibbleBitArray; AVal: Longword): |
| THexNibbleBitArray; |
| function NibbleBitArrayAnd(ABitArray, ABitArray2: THexNibbleBitArray): |
| THexNibbleBitArray; |
| function NibbleBitArrayOr(ABitArray, ABitArray2: THexNibbleBitArray): |
| THexNibbleBitArray; |
| function NibbleBitArrayXor(ABitArray, ABitArray2: THexNibbleBitArray): |
| THexNibbleBitArray; |
| function NibbleBitArrayNot(ABitArray: THexNibbleBitArray): THexNibbleBitArray; |
| // Inverse the bits of a nibble |
| function InverseNibbleBits(x: Nibble): Nibble; |
| // Reverses the bit sequence of a nibble |
| function ReverseNibbleBitSequence(ANibble: Nibble): Nibble; |
| // * EXCEPTIONS * |
| type |
| EInvalidBitString = class(Exception); |
| EBitStringTooLong = class(EInvalidBitString); |
| EBitStringInvalidCharacter = class(EInvalidBitString); |
| // * CONSTANTS * |
| // Lookup tables to avoid calculation each time |
| const |
| AllSetBitsBytes: array[TBytePos] of int64 = |
| ($00000000000000FF, |
| $000000000000FFFF, |
| $0000000000FFFFFF, |
| $00000000FFFFFFFF, |
| $000000FFFFFFFFFF, |
| $0000FFFFFFFFFFFF, |
| $00FFFFFFFFFFFFFF, |
| $FFFFFFFFFFFFFFFF); |
| AllSetBitsNibbles: array[THexNibblePos] of int64 = |
| ($000000000000000F, |
| $00000000000000FF, |
| $0000000000000FFF, |
| $000000000000FFFF, |
| $00000000000FFFFF, |
| $0000000000FFFFFF, |
| $000000000FFFFFFF, |
| $00000000FFFFFFFF, |
| $0000000FFFFFFFFF, |
| $000000FFFFFFFFFF, |
| $00000FFFFFFFFFFF, |
| $0000FFFFFFFFFFFF, |
| $000FFFFFFFFFFFFF, |
| $00FFFFFFFFFFFFFF, |
| $0FFFFFFFFFFFFFFF, |
| $FFFFFFFFFFFFFFFF); |
| AllSetBitsNibble: array[THexNibblePos] of int64 = |
| ($000000000000000F, |
| $00000000000000F0, |
| $0000000000000F00, |
| $000000000000F000, |
| $00000000000F0000, |
| $0000000000F00000, |
| $000000000F000000, |
| $00000000F0000000, |
| $0000000F00000000, |
| $000000F000000000, |
| $00000F0000000000, |
| $0000F00000000000, |
| $000F000000000000, |
| $00F0000000000000, |
| $0F00000000000000, |
| $F000000000000000); |
| // Deprecated function: |
| // function GetSingleBit(ABit: T64BitPos): Int64; |
| // |
| // Gives you a 64 bit datatype which is representing the binary coding |
| // |
| // 00000000 00000000 00000000 00000000 00000000 00000000 00000000 00000001, |
| // 00000000 00000000 00000000 00000000 00000000 00000000 00000000 00000010, |
| // 00000000 00000000 00000000 00000000 00000000 00000000 00000000 00000100, |
| // 00000000 00000000 00000000 00000000 00000000 00000000 00000000 00001000, |
| // 00000000 00000000 00000000 00000000 00000000 00000000 00000000 00010000, |
| // 00000000 00000000 00000000 00000000 00000000 00000000 00000000 00100000, |
| // 00000000 00000000 00000000 00000000 00000000 00000000 00000000 01000000, |
| // 00000000 00000000 00000000 00000000 00000000 00000000 00000000 10000000, |
| // 00000000 00000000 00000000 00000000 00000000 00000000 00000001 00000000, |
| // ... |
| // 10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000. |
| // |
| // Limitation because of the data type: 64 Bit |
| // |
| // For the GetByteBit() and SetByteBit functions we only need this array to |
| // be max at $80 (128). |
| // Manual calculation (not 64 bit useable) would be |
| // result := Math.Floor(Math.Power(2, ABit)); |
| SingleBitArray: array[T64BitPos] of int64 = |
| ($0000000000000001, $0000000000000002, $0000000000000004, $0000000000000008, |
| $0000000000000010, $0000000000000020, $0000000000000040, $0000000000000080, |
| $0000000000000100, $0000000000000200, $0000000000000400, $0000000000000800, |
| $0000000000001000, $0000000000002000, $0000000000004000, $0000000000008000, |
| $0000000000010000, $0000000000020000, $0000000000040000, $0000000000080000, |
| $0000000000100000, $0000000000200000, $0000000000400000, $0000000000800000, |
| $0000000001000000, $0000000002000000, $0000000004000000, $0000000008000000, |
| $0000000010000000, $0000000020000000, $0000000040000000, $0000000080000000, |
| $0000000100000000, $0000000200000000, $0000000400000000, $0000000800000000, |
| $0000001000000000, $0000002000000000, $0000004000000000, $0000008000000000, |
| $0000010000000000, $0000020000000000, $0000040000000000, $0000080000000000, |
| $0000100000000000, $0000200000000000, $0000400000000000, $0000800000000000, |
| $0001000000000000, $0002000000000000, $0004000000000000, $0008000000000000, |
| $0010000000000000, $0020000000000000, $0040000000000000, $0080000000000000, |
| $0100000000000000, $0200000000000000, $0400000000000000, $0800000000000000, |
| $1000000000000000, $2000000000000000, $4000000000000000, $8000000000000000); |
| // Deprecated function: |
| // function GetSingleBitDynamicInversed(ABit: T64BitPos): Int64; |
| // |
| // Gives you a 64 bit datatype which is representing the dynamic inversed |
| // binary encoding. (Dynamic inversed means, that only the used bytes get |
| // inverted, so this is NOT the same as "NOT GetSingleBit(ABit)"!) |
| // |
| // 00000000 00000000 00000000 00000000 00000000 00000000 00000000 11111110, |
| // 00000000 00000000 00000000 00000000 00000000 00000000 00000000 11111101, |
| // 00000000 00000000 00000000 00000000 00000000 00000000 00000000 11111011, |
| // 00000000 00000000 00000000 00000000 00000000 00000000 00000000 11110111, |
| // 00000000 00000000 00000000 00000000 00000000 00000000 00000000 11101111, |
| // 00000000 00000000 00000000 00000000 00000000 00000000 00000000 11011111, |
| // 00000000 00000000 00000000 00000000 00000000 00000000 00000000 10111111, |
| // 00000000 00000000 00000000 00000000 00000000 00000000 00000000 01111111, |
| // 00000000 00000000 00000000 00000000 00000000 00000000 11111110 11111111, |
| // ... |
| // 01111111 11111111 11111111 11111111 11111111 11111111 11111111 11111111. |
| // |
| // Limitation because of the data type: 64 Bit |
| // |
| // Manual calculation (not 64 bit useable) would be |
| // result := MathFloor( |
| // Math.Power(256, Math.Floor(ABit / 8)+1)-1 {***} - |
| // Math.Power(2, ABit)); |
| // |
| // *** is the maximal value of the byte amount we were requesting. |
| // Example: |
| // If ABit in [ 0.. 7] => 1 Byte used => (256^1-1) = $FF |
| // If ABit in [ 8..15] => 2 Bytes used => (256^2-1) = $FF FF |
| // If ABit in [16..23] => 3 Bytes used => (256^3-1) = $FF FF FF |
| // If ABit in [24..31] => 4 Bytes used => (256^3-1) = $FF FF FF FF |
| // ... |
| SingleBitArrayDynamicInversed: array[T64BitPos] of int64 = |
| ($00000000000000FE, $00000000000000FD, $00000000000000FB, $00000000000000F7, |
| $00000000000000EF, $00000000000000DF, $00000000000000BF, $000000000000007F, |
| $000000000000FEFF, $000000000000FDFF, $000000000000FBFF, $000000000000F7FF, |
| $000000000000EFFF, $000000000000DFFF, $000000000000BFFF, $0000000000007FFF, |
| $0000000000FEFFFF, $0000000000FDFFFF, $0000000000FBFFFF, $0000000000F7FFFF, |
| $0000000000EFFFFF, $0000000000DFFFFF, $0000000000BFFFFF, $00000000007FFFFF, |
| $00000000FEFFFFFF, $00000000FDFFFFFF, $00000000FBFFFFFF, $00000000F7FFFFFF, |
| $00000000EFFFFFFF, $00000000DFFFFFFF, $00000000BFFFFFFF, $000000007FFFFFFF, |
| $000000FEFFFFFFFF, $000000FDFFFFFFFF, $000000FBFFFFFFFF, $000000F7FFFFFFFF, |
| $000000EFFFFFFFFF, $000000DFFFFFFFFF, $000000BFFFFFFFFF, $0000007FFFFFFFFF, |
| $0000FEFFFFFFFFFF, $0000FDFFFFFFFFFF, $0000FBFFFFFFFFFF, $0000F7FFFFFFFFFF, |
| $0000EFFFFFFFFFFF, $0000DFFFFFFFFFFF, $0000BFFFFFFFFFFF, $00007FFFFFFFFFFF, |
| $00FEFFFFFFFFFFFF, $00FDFFFFFFFFFFFF, $00FBFFFFFFFFFFFF, $00F7FFFFFFFFFFFF, |
| $00EFFFFFFFFFFFFF, $00DFFFFFFFFFFFFF, $00BFFFFFFFFFFFFF, $007FFFFFFFFFFFFF, |
| $FEFFFFFFFFFFFFFF, $FDFFFFFFFFFFFFFF, $FBFFFFFFFFFFFFFF, $F7FFFFFFFFFFFFFF, |
| $EFFFFFFFFFFFFFFF, $DFFFFFFFFFFFFFFF, $BFFFFFFFFFFFFFFF, $7FFFFFFFFFFFFFFF); |
| // Gives you a 64 bit datatype which is representing the inversed |
| // binary encoding. |
| // |
| // 11111111 11111111 11111111 11111111 11111111 11111111 11111111 11111110, |
| // 11111111 11111111 11111111 11111111 11111111 11111111 11111111 11111101, |
| // 11111111 11111111 11111111 11111111 11111111 11111111 11111111 11111011, |
| // 11111111 11111111 11111111 11111111 11111111 11111111 11111111 11110111, |
| // 11111111 11111111 11111111 11111111 11111111 11111111 11111111 11101111, |
| // 11111111 11111111 11111111 11111111 11111111 11111111 11111111 11011111, |
| // 11111111 11111111 11111111 11111111 11111111 11111111 11111111 10111111, |
| // 11111111 11111111 11111111 11111111 11111111 11111111 11111111 01111111, |
| // 11111111 11111111 11111111 11111111 11111111 11111111 11111110 11111111, |
| // ... |
| // 01111111 11111111 11111111 11111111 11111111 11111111 11111111 11111111. |
| // |
| // Limitation because of the data type: 64 Bit |
| // |
| // Manual calculation (not 64 bit useable) would be |
| // result := NOT GetSingleBit(ABit) |
| // |
| SingleBitArrayInversed: array[T64BitPos] of int64 = |
| ($FFFFFFFFFFFFFFFE, $FFFFFFFFFFFFFFFD, $FFFFFFFFFFFFFFFB, $FFFFFFFFFFFFFFF7, |
| $FFFFFFFFFFFFFFEF, $FFFFFFFFFFFFFFDF, $FFFFFFFFFFFFFFBF, $FFFFFFFFFFFFFF7F, |
| $FFFFFFFFFFFFFEFF, $FFFFFFFFFFFFFDFF, $FFFFFFFFFFFFFBFF, $FFFFFFFFFFFFF7FF, |
| $FFFFFFFFFFFFEFFF, $FFFFFFFFFFFFDFFF, $FFFFFFFFFFFFBFFF, $FFFFFFFFFFFF7FFF, |
| $FFFFFFFFFFFEFFFF, $FFFFFFFFFFFDFFFF, $FFFFFFFFFFFBFFFF, $FFFFFFFFFFF7FFFF, |
| $FFFFFFFFFFEFFFFF, $FFFFFFFFFFDFFFFF, $FFFFFFFFFFBFFFFF, $FFFFFFFFFF7FFFFF, |
| $FFFFFFFFFEFFFFFF, $FFFFFFFFFDFFFFFF, $FFFFFFFFFBFFFFFF, $FFFFFFFFF7FFFFFF, |
| $FFFFFFFFEFFFFFFF, $FFFFFFFFDFFFFFFF, $FFFFFFFFBFFFFFFF, $FFFFFFFF7FFFFFFF, |
| $FFFFFFFEFFFFFFFF, $FFFFFFFDFFFFFFFF, $FFFFFFFBFFFFFFFF, $FFFFFFF7FFFFFFFF, |
| $FFFFFFEFFFFFFFFF, $FFFFFFDFFFFFFFFF, $FFFFFFBFFFFFFFFF, $FFFFFF7FFFFFFFFF, |
| $FFFFFEFFFFFFFFFF, $FFFFFDFFFFFFFFFF, $FFFFFBFFFFFFFFFF, $FFFFF7FFFFFFFFFF, |
| $FFFFEFFFFFFFFFFF, $FFFFDFFFFFFFFFFF, $FFFFBFFFFFFFFFFF, $FFFF7FFFFFFFFFFF, |
| $FFFEFFFFFFFFFFFF, $FFFDFFFFFFFFFFFF, $FFFBFFFFFFFFFFFF, $FFF7FFFFFFFFFFFF, |
| $FFEFFFFFFFFFFFFF, $FFDFFFFFFFFFFFFF, $FFBFFFFFFFFFFFFF, $FF7FFFFFFFFFFFFF, |
| $FEFFFFFFFFFFFFFF, $FDFFFFFFFFFFFFFF, $FBFFFFFFFFFFFFFF, $F7FFFFFFFFFFFFFF, |
| $EFFFFFFFFFFFFFFF, $DFFFFFFFFFFFFFFF, $BFFFFFFFFFFFFFFF, $7FFFFFFFFFFFFFFF); |
| implementation |
| resourcestring |
| LngEBitStringInvalidCharacter = 'The bitstring "%s" contains a invalid ' + |
| 'character. Unexpected character "%s" at position "%d".'; |
| LngEBitStringTooLong = 'The bitstring "%s" is too long. Expected: %d byte.'; |
| function GetByteBitArray(AByte: Byte): TByteBitArray; |
| var |
| i: T8BitPos; |
| begin |
| for i := Low(T8BitPos) to High(T8BitPos) do |
| begin |
| // result[i] := GetByteBit(AByte, i); |
| result[i] := AByte and SingleBitArray[i] = SingleBitArray[i]; |
| end; |
| end; |
| function GetNibbleBitArray(ANibble: Nibble): THexNibbleBitArray; |
| var |
| i: T4BitPos; |
| begin |
| for i := Low(T4BitPos) to High(T4BitPos) do |
| begin |
| // result[i] := GetNibbleBit(ANibble, i); |
| result[i] := ANibble and SingleBitArray[i] = SingleBitArray[i]; |
| end; |
| end; |
| function BuildByte(AUpperNibble, ALowerNibble: THexNibble): Byte; |
| begin |
| // result := $10 * AUpperNibble + ALowerNibble; |
| result := (AUpperNibble shl 4) + ALowerNibble; |
| end; |
| function BuildByte(ABitArray: TByteBitArray): Byte; |
| var |
| i: T8BitPos; |
| begin |
| result := 0; |
| for i := Low(T8BitPos) to High(T8BitPos) do |
| begin |
| // SetByteBit(result, i, ABitArray[i]); |
| if not ABitArray[i] then |
| result := result and SingleBitArrayDynamicInversed[i] |
| else |
| result := result or SingleBitArray[i]; |
| end; |
| end; |
| function BuildByte(ABits: TByteBitString): Byte; |
| begin |
| result := BuildByte(ByteBitArrayFromBitString(ABits)); |
| end; |
| function BuildByte(ABit1, ABit2, ABit3, ABit4, ABit5, ABit6, ABit7, |
| ABit8: TBit): Byte; overload; |
| var |
| ba: TByteBitArray; |
| begin |
| ba[0] := ABit1; |
| ba[1] := ABit2; |
| ba[2] := ABit3; |
| ba[3] := ABit4; |
| ba[4] := ABit5; |
| ba[5] := ABit6; |
| ba[6] := ABit7; |
| ba[7] := ABit8; |
| result := BuildByte(ba); |
| end; |
| function ByteBitArrayFromBitString(const ABits: TByteBitString): TByteBitArray; |
| var |
| i: integer; |
| begin |
| if Length(ABits) <> 8 then |
| begin |
| raise EBitStringTooLong.CreateFmt(LngEBitStringTooLong, [ABits, 8]); |
| exit; |
| end; |
| for i := 1 to Length(ABits) do |
| begin |
| case ABits[i] of |
| '0': result[i-1] := false; |
| '1': result[i-1] := true; |
| else |
| raise EBitStringInvalidCharacter.CreateFmt(LngEBitStringInvalidCharacter, |
| [ABits, ABits[i], i]); |
| end; |
| end; |
| end; |
| function NibbleBitArrayFromBitString(const ABits: THexNibbleBitString): |
| THexNibbleBitArray; |
| var |
| i: integer; |
| begin |
| if Length(ABits) <> 4 then |
| begin |
| raise EBitStringTooLong.CreateFmt(LngEBitStringTooLong, [ABits, 4]); |
| exit; |
| end; |
| for i := 1 to Length(ABits) do |
| begin |
| case ABits[i] of |
| '0': result[i-1] := false; |
| '1': result[i-1] := true; |
| else |
| raise EBitStringInvalidCharacter.CreateFmt(LngEBitStringInvalidCharacter, |
| [ABits, ABits[i], i]); |
| end; |
| end; |
| end; |
| function BuildNibble(ABit1, ABit2, ABit3, ABit4: TBit): Nibble; |
| var |
| ba: THexNibbleBitArray; |
| begin |
| ba[0] := ABit1; |
| ba[1] := ABit2; |
| ba[2] := ABit3; |
| ba[3] := ABit4; |
| result := BuildNibble(ba); |
| end; |
| function BuildNibble(ABitArray: THexNibbleBitArray): Nibble; |
| var |
| i: T4BitPos; |
| begin |
| result := 0; |
| for i := Low(T4BitPos) to High(T4BitPos) do |
| begin |
| // SetNibbleBit(result, i, ABitArray[i]); |
| if not ABitArray[i] then |
| result := result and SingleBitArrayDynamicInversed[i] |
| else |
| result := result or SingleBitArray[i]; |
| end; |
| end; |
| function BuildNibble(ABits: THexNibbleBitString): Nibble; |
| begin |
| result := BuildNibble(NibbleBitArrayFromBitString(ABits)); |
| end; |
| function GetLowerNibble(AByte: Byte): THexNibble; |
| begin |
| result := AByte and AllSetBitsNibble[0]; |
| end; |
| function SetLowerNibble(AByte: Byte; ANewNibble: THexNibble): Byte; |
| begin |
| // result := BuildByte(GetUpperNibble(AByte), ANewNibble); |
| // result := $10 * (AByte and AllSetBitsNibble[1] shr 4) + ANewNibble; |
| // result := (AByte and AllSetBitsNibble[1] shr 4) shl 4 + ANewNibble; |
| // Optimized: "shr 4 shl 4" removed |
| result := (AByte and AllSetBitsNibble[1]) + ANewNibble; |
| end; |
| function GetUpperNibble(AByte: Byte): THexNibble; |
| begin |
| result := AByte and AllSetBitsNibble[1] shr 4; |
| end; |
| function SetUpperNibble(AByte: Byte; ANewNibble: THexNibble): Byte; |
| begin |
| // result := BuildByte(ANewNibble, GetLowerNibble(AByte)); |
| // result := ($10 * ANewNibble) + (AByte and AllSetBitsNibble[0]); |
| result := (ANewNibble shl 4) + (AByte and AllSetBitsNibble[0]); |
| end; |
| function GetByteBit(AByte: Byte; ABitPos: T8BitPos): TBit; |
| begin |
| // result := AByte and SingleBitArray[ABitPos] shr ABitPos = 1; |
| // result := AByte and Math.Power(2, ABitPos) shr ABitPos = 1; |
| // result := AByte and SingleBitArray[ABitPos] shr ABitPos = 1; |
| result := AByte and SingleBitArray[ABitPos] = SingleBitArray[ABitPos]; |
| end; |
| function SetByteBit(AByte: Byte; ABitPos: T8BitPos; ANewBit: TBit): Byte; |
| begin |
| if not ANewBit then |
| begin |
| // Set a bit to 0. |
| // Example: abcdefgh AND 11111011 = abcde0gh |
| // result := AByte and (AllSetBitsBytes[0] - SingleBitArray[ABitPos]); |
| // result := AByte and (AllSetBitsBytes[0] - Math.Power(2, ABitPos)); |
| result := AByte and SingleBitArrayDynamicInversed[ABitPos] |
| end |
| else |
| begin |
| // Set a bit to 1. |
| // Example: abcdefgh OR 00000100 = abcde1gh |
| // result := AByte or Math.Power(2, ABitPos); |
| result := AByte or SingleBitArray[ABitPos]; |
| end; |
| end; |
| function GetNibbleBit(ANibble: Nibble; ABitPos: T4BitPos): TBit; |
| begin |
| result := GetByteBit(ANibble, ABitPos); |
| end; |
| function SetNibbleBit(ANibble: Nibble; ABitPos: T4BitPos; |
| ANewBit: TBit): Nibble; |
| begin |
| result := SetByteBit(ANibble, ABitPos, ANewBit); |
| end; |
| function ByteBitArrayShr(ABitArray: TByteBitArray; |
| AVal: Longword): TByteBitArray; |
| var |
| b: Byte; |
| begin |
| b := BuildByte(ABitArray); |
| result := GetByteBitArray(b shr AVal); |
| end; |
| function ByteBitArrayShl(ABitArray: TByteBitArray; |
| AVal: Longword): TByteBitArray; |
| var |
| b: Byte; |
| begin |
| b := BuildByte(ABitArray); |
| result := GetByteBitArray(b shl AVal); |
| end; |
| function ByteBitArrayAnd(ABitArray, ABitArray2: TByteBitArray): TByteBitArray; |
| var |
| b, b2: Byte; |
| begin |
| b := BuildByte(ABitArray); |
| b2 := BuildByte(ABitArray2); |
| result := GetByteBitArray(b and b2); |
| end; |
| function ByteBitArrayOr(ABitArray, ABitArray2: TByteBitArray): TByteBitArray; |
| var |
| b, b2: Byte; |
| begin |
| b := BuildByte(ABitArray); |
| b2 := BuildByte(ABitArray2); |
| result := GetByteBitArray(b or b2); |
| end; |
| function ByteBitArrayXor(ABitArray, ABitArray2: TByteBitArray): TByteBitArray; |
| var |
| b, b2: Byte; |
| begin |
| b := BuildByte(ABitArray); |
| b2 := BuildByte(ABitArray2); |
| result := GetByteBitArray(b xor b2); |
| end; |
| function ByteBitArrayNot(ABitArray: TByteBitArray): TByteBitArray; |
| var |
| b: Byte; |
| begin |
| b := BuildByte(ABitArray); |
| result := GetByteBitArray(not b); |
| end; |
| function NibbleBitArrayShr(ABitArray: THexNibbleBitArray; AVal: Longword): |
| THexNibbleBitArray; |
| var |
| b: Nibble; |
| begin |
| b := BuildNibble(ABitArray); |
| result := GetNibbleBitArray(b shr AVal); |
| end; |
| function NibbleBitArrayShl(ABitArray: THexNibbleBitArray; AVal: Longword): |
| THexNibbleBitArray; |
| var |
| b: Nibble; |
| begin |
| b := BuildNibble(ABitArray); |
| result := GetNibbleBitArray(b shl AVal); |
| end; |
| function NibbleBitArrayAnd(ABitArray, ABitArray2: THexNibbleBitArray): |
| THexNibbleBitArray; |
| var |
| b, b2: Nibble; |
| begin |
| b := BuildNibble(ABitArray); |
| b2 := BuildNibble(ABitArray2); |
| result := GetNibbleBitArray(b and b2); |
| end; |
| function NibbleBitArrayOr(ABitArray, ABitArray2: THexNibbleBitArray): |
| THexNibbleBitArray; |
| var |
| b, b2: Nibble; |
| begin |
| b := BuildNibble(ABitArray); |
| b2 := BuildNibble(ABitArray2); |
| result := GetNibbleBitArray(b or b2); |
| end; |
| function NibbleBitArrayXor(ABitArray, ABitArray2: THexNibbleBitArray): |
| THexNibbleBitArray; |
| var |
| b, b2: Nibble; |
| begin |
| b := BuildNibble(ABitArray); |
| b2 := BuildNibble(ABitArray2); |
| result := GetNibbleBitArray(b xor b2); |
| end; |
| function NibbleBitArrayNot(ABitArray: THexNibbleBitArray): THexNibbleBitArray; |
| var |
| b: Nibble; |
| begin |
| b := BuildNibble(ABitArray); |
| result := GetNibbleBitArray(not b); |
| end; |
| function InverseByteBits(x: Byte): Byte; |
| begin |
| // 10110001 |
| // xor 11111111 |
| // = 01001110 |
| result := x xor AllSetBitsBytes[0]; |
| end; |
| function InverseNibbleBits(x: Nibble): Nibble; |
| begin |
| // 0001 |
| // xor 1111 |
| // = 1110 |
| result := x xor AllSetBitsNibbles[0]; |
| end; |
| function InterchangeNibbles(AByte: Byte): Byte; |
| begin |
| // result := BuildByte(GetLowerNibble(AByte), GetUpperNibble(AByte)); |
| result := (AByte and AllSetBitsNibble[0] shl 4) + |
| (AByte and AllSetBitsNibble[1] shr 4) |
| end; |
| function ReverseByteBitSequence(AByte: Byte): Byte; |
| var |
| ba: TByteBitArray; |
| begin |
| ba := GetByteBitArray(AByte); |
| result := BuildByte(ba[7], ba[6], ba[5], ba[4], ba[3], ba[2], ba[1], ba[0]); |
| end; |
| function ReverseNibbleBitSequence(ANibble: Nibble): Nibble; |
| var |
| ba: THexNibbleBitArray; |
| begin |
| ba := GetNibbleBitArray(ANibble); |
| result := BuildNibble(ba[3], ba[2], ba[1], ba[0]); |
| end; |
| end. |
| /Units/HighPerfFileComparator.pas |
|---|
| 0,0 → 1,605 |
| unit HighPerfFileComparator; |
| (* |
| HighPerfFileComparator.pas |
| (C) 2010 ViaThinkSoft, Daniel Marschall |
| Last modified: January, 21th 2010 |
| THighPerfFileComparator.compare(filenameA, filenameB: string): boolean; |
| Compares two files primary with size comparison and |
| secundary with MD5 hash comparison. All results will be cached. |
| Note: If you want to use the cache for every file, please do not |
| destroy the instance of THighPerfFileComparator after done your job. |
| Use in a field of your form class and free it when the application |
| closes. |
| Example of usage: |
| var |
| comparator: THighPerfFileComparator; |
| procedure TForm1.FormCreate(Sender: TObject); |
| begin |
| comparator := THighPerfFileComparator.Create; |
| end; |
| procedure TForm1.Button1Click(Sender: TObject); |
| begin |
| // This deletes all cached file hashs, so that the result will be |
| // new calculated. Alternatively you can create a new |
| // THighPerfFileComparator at the beginning of every new job. |
| comparator.clearCache; |
| if comparator.Compare('C:\a.txt', 'C:\b.txt') then |
| ShowMessage('Files are equal') |
| else |
| ShowMessage('Files are not equal'); |
| end; |
| procedure TForm1.FormDestroy(Sender: TObject); |
| begin |
| comparator.Free; |
| end; |
| Class hierarchie: |
| Exception |
| EFileNotFound |
| ENoRegisteredComparators |
| TObject |
| (TContainer) |
| (TStringContainer) |
| (TInteger64Container) |
| TCacheManager |
| TFilenameCacheManager |
| TInteger64CacheManager |
| TStringCacheManager |
| TInterfacedObject |
| TComparator |
| TFileComparator |
| THashMD5Comparator |
| TCachedHashMD5Comparator [ICachedComparator] |
| TSizeComparator |
| TCachedSizeComparator [ICachedComparator] |
| TMultipleFileComparators |
| TCachedSizeHashMD5FileComparator [ICachedComparator] |
| = THighPerfFileComparator |
| *) |
| interface |
| uses |
| SysUtils, Classes, Contnrs; |
| type |
| ICachedComparator = interface(IInterface) |
| // private |
| procedure SetCacheEnabled(Value: boolean); |
| function GetCacheEnabled: boolean; |
| // public |
| property CacheEnabled: boolean read getCacheEnabled write setCacheEnabled; |
| procedure ClearCache; |
| end; |
| EFileNotFound = class(Exception); |
| ENoRegisteredComparators = class(Exception); |
| TCacheManager = class(TObject) |
| private |
| FCache: TStringList; |
| public |
| procedure SetCache(identifier: string; cacheObject: TObject); |
| function GetCache(identifier: string): TObject; |
| function IsCached(identifier: string): boolean; |
| procedure Clear; |
| constructor Create; |
| destructor Destroy; override; |
| end; |
| // TFilenameCacheManager extends every filename to a unique identifier |
| TFilenameCacheManager = class(TCacheManager) |
| protected |
| function FullQualifiedFilename(filename: string): string; |
| public |
| procedure SetCache(filename: string; cacheObject: TObject); |
| function GetCache(filename: string): TObject; |
| function IsCached(filename: string): boolean; |
| end; |
| // Wäre eigentlich ein guter Ansatz für Mehrfachvererbung... |
| TInteger64CacheManager = class(TFilenameCacheManager) |
| public |
| procedure SetCache(filename: string; content: int64); |
| function GetCache(filename: string): int64; |
| end; |
| TStringCacheManager = class(TFilenameCacheManager) |
| public |
| procedure SetCache(filename: string; content: string); |
| function GetCache(filename: string): string; |
| end; |
| TComparator = class(TInterfacedObject) // abstract |
| public |
| function Compare(a, b: string): boolean; virtual; abstract; |
| end; |
| TFileComparator = class(TComparator) // abstract |
| protected |
| // Please call this method for both filenames at every Compare() |
| // call of your derivates. |
| procedure CheckFileExistence(filename: string); |
| public |
| // This is an abstract method since it only checks filenames and returns |
| // always false. |
| // function Compare(filenameA, filenameB: string): boolean; override; |
| end; |
| TSizeComparator = class(TFileComparator) |
| protected |
| function GetFileSize(filename: string): Int64; virtual; |
| public |
| function Compare(filenameA, filenameB: string): boolean; override; |
| end; |
| TCachedSizeComparator = class(TSizeComparator, ICachedComparator) |
| private |
| FCacheManager: TInteger64CacheManager; |
| FCacheEnabled: boolean; |
| procedure SetCacheEnabled(Value: boolean); |
| function GetCacheEnabled: boolean; |
| protected |
| function GetFileSize(filename: string): Int64; override; |
| public |
| property CacheEnabled: boolean read getCacheEnabled write setCacheEnabled; |
| procedure ClearCache; |
| constructor Create; |
| destructor Destroy; override; |
| end; |
| THashMD5Comparator = class(TFileComparator) |
| protected |
| function GetFileHashMD5(filename: string): String; virtual; |
| public |
| function Compare(filenameA, filenameB: string): boolean; override; |
| end; |
| TCachedHashMD5Comparator = class(THashMD5Comparator, ICachedComparator) |
| private |
| FCacheManager: TStringCacheManager; |
| FCacheEnabled: boolean; |
| procedure SetCacheEnabled(Value: boolean); |
| function GetCacheEnabled: boolean; |
| protected |
| function GetFileHashMD5(filename: string): String; override; |
| public |
| property CacheEnabled: boolean read getCacheEnabled write setCacheEnabled; |
| procedure ClearCache; |
| constructor Create; |
| destructor Destroy; override; |
| end; |
| TMultipleFileComparators = class(TFileComparator) // abstract |
| // This is an abstract class since no comparators are registered and so |
| // compare() will throw an ENoRegisteredComparators exception. |
| protected |
| // WARNING: DOES *NOT* OWNS ITS OBJECTS. PLEASE FREE THEM ON DESTROY. |
| FRegisteredComparators: TObjectList; // of TFileComparator |
| procedure RegisterComparator(comparator: TFileComparator); |
| public |
| function Compare(filenameA, filenameB: string): boolean; override; |
| constructor Create; |
| destructor Destroy; override; |
| end; |
| TCachedSizeHashMD5FileComparator = class(TMultipleFileComparators, |
| ICachedComparator) |
| private |
| FHashComparator: TCachedHashMD5Comparator; |
| FSizeComparator: TCachedSizeComparator; |
| procedure SetCacheEnabled(Value: boolean); |
| function GetCacheEnabled: boolean; |
| public |
| property CacheEnabled: boolean read getCacheEnabled write setCacheEnabled; |
| procedure ClearCache; |
| constructor Create; |
| destructor Destroy; override; |
| end; |
| THighPerfFileComparator = TCachedSizeHashMD5FileComparator; |
| implementation |
| // Please download MD5.pas from |
| // http://www.koders.com/delphi/fid1C4B47A76F8C7172FDCFE7B3A74863D6FB7FC2BA.aspx |
| uses |
| MD5; |
| resourcestring |
| LNG_E_NO_REGISTERED_COMPARATORS = 'No comparators registered. Please use ' + |
| 'a derivate of the class TMultipleFileComparators which does register ' + |
| 'comparators.'; |
| LNG_E_FILE_NOT_FOUND = 'The file "%s" was not found.'; |
| type |
| TContainer = class(TObject); |
| TStringContainer = class(TContainer) |
| public |
| Content: string; |
| constructor Create(AContent: string); |
| end; |
| TInteger64Container = class(TContainer) |
| public |
| Content: int64; |
| constructor Create(AContent: int64); |
| end; |
| { Functions } |
| function _MD5File(filename: string): string; |
| begin |
| result := MD5Print(MD5File(filename)); |
| end; |
| { TStringContainer } |
| constructor TStringContainer.Create(AContent: string); |
| begin |
| inherited Create; |
| content := AContent; |
| end; |
| { TInteger64Container } |
| constructor TInteger64Container.Create(AContent: int64); |
| begin |
| inherited Create; |
| content := AContent; |
| end; |
| { TCacheManager } |
| procedure TCacheManager.SetCache(identifier: string; cacheObject: TObject); |
| begin |
| FCache.AddObject(identifier, cacheObject); |
| end; |
| function TCacheManager.GetCache(identifier: string): TObject; |
| begin |
| if isCached(identifier) then |
| result := FCache.Objects[FCache.IndexOf(identifier)] as TContainer |
| else |
| result := nil; |
| end; |
| function TCacheManager.IsCached(identifier: string): boolean; |
| begin |
| result := FCache.IndexOf(identifier) <> -1; |
| end; |
| procedure TCacheManager.Clear; |
| begin |
| FCache.Clear; |
| end; |
| constructor TCacheManager.Create; |
| begin |
| inherited Create; |
| FCache := TStringList.Create; |
| end; |
| destructor TCacheManager.Destroy; |
| begin |
| FCache.Free; |
| inherited Destroy; |
| end; |
| { TFilenameCacheManager } |
| function TFilenameCacheManager.FullQualifiedFilename(filename: string): string; |
| begin |
| result := ExpandUNCFileName(filename); |
| end; |
| procedure TFilenameCacheManager.SetCache(filename: string; |
| cacheObject: TObject); |
| begin |
| inherited setCache(FullQualifiedFilename(filename), cacheObject); |
| end; |
| function TFilenameCacheManager.GetCache(filename: string): TObject; |
| begin |
| result := inherited getCache(FullQualifiedFilename(filename)); |
| end; |
| function TFilenameCacheManager.IsCached(filename: string): boolean; |
| begin |
| result := inherited isCached(FullQualifiedFilename(filename)); |
| end; |
| { TInteger64CacheManager } |
| procedure TInteger64CacheManager.SetCache(filename: string; content: int64); |
| begin |
| inherited setCache(filename, TInteger64Container.Create(content)); |
| end; |
| function TInteger64CacheManager.GetCache(filename: string): int64; |
| begin |
| result := (inherited getCache(filename) as TInteger64Container).content; |
| end; |
| { TStringCacheManager } |
| procedure TStringCacheManager.SetCache(filename: string; content: string); |
| begin |
| inherited setCache(filename, TStringContainer.Create(content)); |
| end; |
| function TStringCacheManager.GetCache(filename: string): string; |
| begin |
| result := (inherited getCache(filename) as TStringContainer).content; |
| end; |
| { TFileComparator } |
| procedure TFileComparator.CheckFileExistence(filename: string); |
| begin |
| if not fileExists(filename) then |
| raise EFileNotFound.CreateFmt(LNG_E_FILE_NOT_FOUND, [filename]); |
| end; |
| (* function TFileComparator.Compare(filenameA, filenameB: string): boolean; |
| begin |
| if not fileExists(filenameA) then |
| raise EFileNotFound.CreateFmt(LNG_E_FILE_NOT_FOUND, [filenameA]); |
| if not fileExists(filenameB) then |
| raise EFileNotFound.CreateFmt(LNG_E_FILE_NOT_FOUND, [filenameB]); |
| // Leider keine Überprüfung, ob Methode überschrieben wurde |
| // (da sonst result immer false ist!) |
| if Self.ClassType = TFileComparator then |
| raise EDirectCall.CreateFmt(LNG_E_DIRECT_CALL, [Self.ClassName]); |
| result := false; |
| end; *) |
| { TSizeComparator } |
| function TSizeComparator.GetFileSize(filename: string): Int64; |
| var |
| f: TFileStream; |
| begin |
| f := TFileStream.Create(filename, fmOpenRead); |
| try |
| result := f.Size |
| finally |
| f.Free; |
| end; |
| end; |
| function TSizeComparator.Compare(filenameA, filenameB: string): boolean; |
| begin |
| //inherited compare(filenameA, filenameB); |
| CheckFileExistence(filenameA); |
| CheckFileExistence(filenameB); |
| result := getFileSize(filenameA) = getFileSize(filenameB); |
| end; |
| { TCachedSizeComparator } |
| procedure TCachedSizeComparator.SetCacheEnabled(Value: boolean); |
| begin |
| if FCacheEnabled <> Value then |
| FCacheEnabled := Value; |
| end; |
| function TCachedSizeComparator.GetCacheEnabled: boolean; |
| begin |
| result := FCacheEnabled; |
| end; |
| function TCachedSizeComparator.GetFileSize(filename: string): Int64; |
| begin |
| if FCacheEnabled then |
| begin |
| if FCacheManager.isCached(filename) then |
| begin |
| result := FCacheManager.getCache(filename); |
| end |
| else |
| begin |
| result := inherited getFileSize(filename); |
| FCacheManager.setCache(filename, result); |
| end; |
| end |
| else |
| result := inherited getFileSize(filename); |
| end; |
| procedure TCachedSizeComparator.ClearCache; |
| begin |
| FCacheManager.clear; |
| end; |
| constructor TCachedSizeComparator.Create; |
| begin |
| inherited Create; |
| FCacheManager := TInteger64CacheManager.Create; |
| FCacheEnabled := true; |
| end; |
| destructor TCachedSizeComparator.Destroy; |
| begin |
| FCacheManager.Free; |
| inherited Destroy; |
| end; |
| { THashMD5Comparator } |
| function THashMD5Comparator.GetFileHashMD5(filename: string): String; |
| begin |
| result := _MD5File(filename); |
| end; |
| function THashMD5Comparator.Compare(filenameA, filenameB: string): boolean; |
| begin |
| //inherited Compare(filenameA, filenameB); |
| CheckFileExistence(filenameA); |
| CheckFileExistence(filenameB); |
| result := GetFileHashMD5(filenameA) = GetFileHashMD5(filenameB); |
| end; |
| { TCachedHashMD5Comparator } |
| procedure TCachedHashMD5Comparator.SetCacheEnabled(Value: boolean); |
| begin |
| if FCacheEnabled <> Value then |
| FCacheEnabled := Value; |
| end; |
| function TCachedHashMD5Comparator.GetCacheEnabled: boolean; |
| begin |
| result := FCacheEnabled; |
| end; |
| function TCachedHashMD5Comparator.GetFileHashMD5(filename: string): String; |
| begin |
| if FCacheEnabled then |
| begin |
| if FCacheManager.IsCached(filename) then |
| begin |
| result := FCacheManager.GetCache(filename); |
| end |
| else |
| begin |
| result := inherited GetFileHashMD5(filename); |
| FCacheManager.SetCache(filename, result); |
| end; |
| end |
| else |
| result := inherited GetFileHashMD5(filename); |
| end; |
| procedure TCachedHashMD5Comparator.ClearCache; |
| begin |
| FCacheManager.Clear; |
| end; |
| constructor TCachedHashMD5Comparator.Create; |
| begin |
| inherited Create; |
| FCacheManager := TStringCacheManager.Create; |
| FCacheEnabled := true; |
| end; |
| destructor TCachedHashMD5Comparator.Destroy; |
| begin |
| FCacheManager.Free; |
| inherited Destroy; |
| end; |
| { TMultipleFileComparators } |
| procedure TMultipleFileComparators.RegisterComparator(comparator: TFileComparator); |
| begin |
| FRegisteredComparators.Add(comparator) |
| end; |
| function TMultipleFileComparators.Compare(filenameA, |
| filenameB: string): boolean; |
| var |
| i: integer; |
| begin |
| //inherited Compare(filenameA, filenameB); |
| CheckFileExistence(filenameA); |
| CheckFileExistence(filenameB); |
| if FRegisteredComparators.Count = 0 then |
| raise ENoRegisteredComparators.Create(LNG_E_NO_REGISTERED_COMPARATORS); |
| for i := 0 to FRegisteredComparators.Count - 1 do |
| begin |
| if not (FRegisteredComparators.Items[i] as TFileComparator). |
| Compare(filenameA, filenameB) then |
| begin |
| result := false; |
| exit; |
| end; |
| end; |
| result := true; |
| end; |
| constructor TMultipleFileComparators.Create; |
| begin |
| inherited Create; |
| FRegisteredComparators := TObjectList.Create(false); |
| end; |
| destructor TMultipleFileComparators.Destroy; |
| begin |
| FRegisteredComparators.Free; |
| inherited Destroy; |
| end; |
| { TCachedSizeHashMD5FileComparator } |
| procedure TCachedSizeHashMD5FileComparator.SetCacheEnabled(Value: boolean); |
| begin |
| FSizeComparator.SetCacheEnabled(Value); |
| FHashComparator.SetCacheEnabled(Value); |
| end; |
| function TCachedSizeHashMD5FileComparator.getCacheEnabled: boolean; |
| begin |
| result := FSizeComparator.GetCacheEnabled and FHashComparator.GetCacheEnabled; |
| end; |
| procedure TCachedSizeHashMD5FileComparator.ClearCache; |
| begin |
| FSizeComparator.ClearCache; |
| FHashComparator.ClearCache; |
| end; |
| constructor TCachedSizeHashMD5FileComparator.Create; |
| begin |
| inherited Create; |
| FSizeComparator := TCachedSizeComparator.Create; |
| RegisterComparator(FSizeComparator); |
| FHashComparator := TCachedHashMD5Comparator.Create; |
| RegisterComparator(FHashComparator); |
| end; |
| destructor TCachedSizeHashMD5FileComparator.Destroy; |
| begin |
| FHashComparator.Free; |
| FSizeComparator.Free; |
| inherited Destroy; |
| end; |
| end. |
| /Units/md5.pas |
|---|
| 0,0 → 1,392 |
| // tabs = 2 |
| // ----------------------------------------------------------------------------------------------- |
| // |
| // MD5 Message-Digest for Delphi 4 |
| // |
| // Delphi 4 Unit implementing the |
| // RSA Data Security, Inc. MD5 Message-Digest Algorithm |
| // |
| // Implementation of Ronald L. Rivest's RFC 1321 |
| // |
| // Copyright 1997-1999 Medienagentur Fichtner & Meyer |
| // Written by Matthias Fichtner |
| // |
| // ----------------------------------------------------------------------------------------------- |
| // See RFC 1321 for RSA Data Security's copyright and license notice! |
| // ----------------------------------------------------------------------------------------------- |
| // |
| // 14-Jun-97 mf Implemented MD5 according to RFC 1321 RFC 1321 |
| // 16-Jun-97 mf Initial release of the compiled unit (no source code) RFC 1321 |
| // 28-Feb-99 mf Added MD5Match function for comparing two digests RFC 1321 |
| // 13-Sep-99 mf Reworked the entire unit RFC 1321 |
| // 17-Sep-99 mf Reworked the "Test Driver" project RFC 1321 |
| // 19-Sep-99 mf Release of sources for MD5 unit and "Test Driver" project RFC 1321 |
| // |
| // ----------------------------------------------------------------------------------------------- |
| // The latest release of md5.pas will always be available from |
| // the distribution site at: http://www.fichtner.net/delphi/md5/ |
| // ----------------------------------------------------------------------------------------------- |
| // Please send questions, bug reports and suggestions |
| // regarding this code to: mfichtner@fichtner-meyer.com |
| // ----------------------------------------------------------------------------------------------- |
| // This code is provided "as is" without express or |
| // implied warranty of any kind. Use it at your own risk. |
| // ----------------------------------------------------------------------------------------------- |
| unit md5; |
| // ----------------------------------------------------------------------------------------------- |
| INTERFACE |
| // ----------------------------------------------------------------------------------------------- |
| uses |
| Windows; |
| type |
| MD5Count = array[0..1] of DWORD; |
| MD5State = array[0..3] of DWORD; |
| MD5Block = array[0..15] of DWORD; |
| MD5CBits = array[0..7] of byte; |
| MD5Digest = array[0..15] of byte; |
| MD5Buffer = array[0..63] of byte; |
| MD5Context = record |
| State: MD5State; |
| Count: MD5Count; |
| Buffer: MD5Buffer; |
| end; |
| procedure MD5Init(var Context: MD5Context); |
| procedure MD5Update(var Context: MD5Context; Input: pChar; Length: longword); |
| procedure MD5Final(var Context: MD5Context; var Digest: MD5Digest); |
| function MD5String(M: string): MD5Digest; |
| function MD5File(N: string): MD5Digest; |
| function MD5Print(D: MD5Digest): string; |
| function MD5Match(D1, D2: MD5Digest): boolean; |
| // ----------------------------------------------------------------------------------------------- |
| IMPLEMENTATION |
| // ----------------------------------------------------------------------------------------------- |
| var |
| PADDING: MD5Buffer = ( |
| $80, $00, $00, $00, $00, $00, $00, $00, |
| $00, $00, $00, $00, $00, $00, $00, $00, |
| $00, $00, $00, $00, $00, $00, $00, $00, |
| $00, $00, $00, $00, $00, $00, $00, $00, |
| $00, $00, $00, $00, $00, $00, $00, $00, |
| $00, $00, $00, $00, $00, $00, $00, $00, |
| $00, $00, $00, $00, $00, $00, $00, $00, |
| $00, $00, $00, $00, $00, $00, $00, $00 |
| ); |
| function F(x, y, z: DWORD): DWORD; |
| begin |
| Result := (x and y) or ((not x) and z); |
| end; |
| function G(x, y, z: DWORD): DWORD; |
| begin |
| Result := (x and z) or (y and (not z)); |
| end; |
| function H(x, y, z: DWORD): DWORD; |
| begin |
| Result := x xor y xor z; |
| end; |
| function I(x, y, z: DWORD): DWORD; |
| begin |
| Result := y xor (x or (not z)); |
| end; |
| procedure rot(var x: DWORD; n: BYTE); |
| begin |
| x := (x shl n) or (x shr (32 - n)); |
| end; |
| procedure FF(var a: DWORD; b, c, d, x: DWORD; s: BYTE; ac: DWORD); |
| begin |
| inc(a, F(b, c, d) + x + ac); |
| rot(a, s); |
| inc(a, b); |
| end; |
| procedure GG(var a: DWORD; b, c, d, x: DWORD; s: BYTE; ac: DWORD); |
| begin |
| inc(a, G(b, c, d) + x + ac); |
| rot(a, s); |
| inc(a, b); |
| end; |
| procedure HH(var a: DWORD; b, c, d, x: DWORD; s: BYTE; ac: DWORD); |
| begin |
| inc(a, H(b, c, d) + x + ac); |
| rot(a, s); |
| inc(a, b); |
| end; |
| procedure II(var a: DWORD; b, c, d, x: DWORD; s: BYTE; ac: DWORD); |
| begin |
| inc(a, I(b, c, d) + x + ac); |
| rot(a, s); |
| inc(a, b); |
| end; |
| // ----------------------------------------------------------------------------------------------- |
| // Encode Count bytes at Source into (Count / 4) DWORDs at Target |
| procedure Encode(Source, Target: pointer; Count: longword); |
| var |
| S: PByte; |
| T: PDWORD; |
| I: longword; |
| begin |
| S := Source; |
| T := Target; |
| for I := 1 to Count div 4 do begin |
| T^ := S^; |
| inc(S); |
| T^ := T^ or (S^ shl 8); |
| inc(S); |
| T^ := T^ or (S^ shl 16); |
| inc(S); |
| T^ := T^ or (S^ shl 24); |
| inc(S); |
| inc(T); |
| end; |
| end; |
| // Decode Count DWORDs at Source into (Count * 4) Bytes at Target |
| procedure Decode(Source, Target: pointer; Count: longword); |
| var |
| S: PDWORD; |
| T: PByte; |
| I: longword; |
| begin |
| S := Source; |
| T := Target; |
| for I := 1 to Count do begin |
| T^ := S^ and $ff; |
| inc(T); |
| T^ := (S^ shr 8) and $ff; |
| inc(T); |
| T^ := (S^ shr 16) and $ff; |
| inc(T); |
| T^ := (S^ shr 24) and $ff; |
| inc(T); |
| inc(S); |
| end; |
| end; |
| // Transform State according to first 64 bytes at Buffer |
| procedure Transform(Buffer: pointer; var State: MD5State); |
| var |
| a, b, c, d: DWORD; |
| Block: MD5Block; |
| begin |
| Encode(Buffer, @Block, 64); |
| a := State[0]; |
| b := State[1]; |
| c := State[2]; |
| d := State[3]; |
| FF (a, b, c, d, Block[ 0], 7, $d76aa478); |
| FF (d, a, b, c, Block[ 1], 12, $e8c7b756); |
| FF (c, d, a, b, Block[ 2], 17, $242070db); |
| FF (b, c, d, a, Block[ 3], 22, $c1bdceee); |
| FF (a, b, c, d, Block[ 4], 7, $f57c0faf); |
| FF (d, a, b, c, Block[ 5], 12, $4787c62a); |
| FF (c, d, a, b, Block[ 6], 17, $a8304613); |
| FF (b, c, d, a, Block[ 7], 22, $fd469501); |
| FF (a, b, c, d, Block[ 8], 7, $698098d8); |
| FF (d, a, b, c, Block[ 9], 12, $8b44f7af); |
| FF (c, d, a, b, Block[10], 17, $ffff5bb1); |
| FF (b, c, d, a, Block[11], 22, $895cd7be); |
| FF (a, b, c, d, Block[12], 7, $6b901122); |
| FF (d, a, b, c, Block[13], 12, $fd987193); |
| FF (c, d, a, b, Block[14], 17, $a679438e); |
| FF (b, c, d, a, Block[15], 22, $49b40821); |
| GG (a, b, c, d, Block[ 1], 5, $f61e2562); |
| GG (d, a, b, c, Block[ 6], 9, $c040b340); |
| GG (c, d, a, b, Block[11], 14, $265e5a51); |
| GG (b, c, d, a, Block[ 0], 20, $e9b6c7aa); |
| GG (a, b, c, d, Block[ 5], 5, $d62f105d); |
| GG (d, a, b, c, Block[10], 9, $2441453); |
| GG (c, d, a, b, Block[15], 14, $d8a1e681); |
| GG (b, c, d, a, Block[ 4], 20, $e7d3fbc8); |
| GG (a, b, c, d, Block[ 9], 5, $21e1cde6); |
| GG (d, a, b, c, Block[14], 9, $c33707d6); |
| GG (c, d, a, b, Block[ 3], 14, $f4d50d87); |
| GG (b, c, d, a, Block[ 8], 20, $455a14ed); |
| GG (a, b, c, d, Block[13], 5, $a9e3e905); |
| GG (d, a, b, c, Block[ 2], 9, $fcefa3f8); |
| GG (c, d, a, b, Block[ 7], 14, $676f02d9); |
| GG (b, c, d, a, Block[12], 20, $8d2a4c8a); |
| HH (a, b, c, d, Block[ 5], 4, $fffa3942); |
| HH (d, a, b, c, Block[ 8], 11, $8771f681); |
| HH (c, d, a, b, Block[11], 16, $6d9d6122); |
| HH (b, c, d, a, Block[14], 23, $fde5380c); |
| HH (a, b, c, d, Block[ 1], 4, $a4beea44); |
| HH (d, a, b, c, Block[ 4], 11, $4bdecfa9); |
| HH (c, d, a, b, Block[ 7], 16, $f6bb4b60); |
| HH (b, c, d, a, Block[10], 23, $bebfbc70); |
| HH (a, b, c, d, Block[13], 4, $289b7ec6); |
| HH (d, a, b, c, Block[ 0], 11, $eaa127fa); |
| HH (c, d, a, b, Block[ 3], 16, $d4ef3085); |
| HH (b, c, d, a, Block[ 6], 23, $4881d05); |
| HH (a, b, c, d, Block[ 9], 4, $d9d4d039); |
| HH (d, a, b, c, Block[12], 11, $e6db99e5); |
| HH (c, d, a, b, Block[15], 16, $1fa27cf8); |
| HH (b, c, d, a, Block[ 2], 23, $c4ac5665); |
| II (a, b, c, d, Block[ 0], 6, $f4292244); |
| II (d, a, b, c, Block[ 7], 10, $432aff97); |
| II (c, d, a, b, Block[14], 15, $ab9423a7); |
| II (b, c, d, a, Block[ 5], 21, $fc93a039); |
| II (a, b, c, d, Block[12], 6, $655b59c3); |
| II (d, a, b, c, Block[ 3], 10, $8f0ccc92); |
| II (c, d, a, b, Block[10], 15, $ffeff47d); |
| II (b, c, d, a, Block[ 1], 21, $85845dd1); |
| II (a, b, c, d, Block[ 8], 6, $6fa87e4f); |
| II (d, a, b, c, Block[15], 10, $fe2ce6e0); |
| II (c, d, a, b, Block[ 6], 15, $a3014314); |
| II (b, c, d, a, Block[13], 21, $4e0811a1); |
| II (a, b, c, d, Block[ 4], 6, $f7537e82); |
| II (d, a, b, c, Block[11], 10, $bd3af235); |
| II (c, d, a, b, Block[ 2], 15, $2ad7d2bb); |
| II (b, c, d, a, Block[ 9], 21, $eb86d391); |
| inc(State[0], a); |
| inc(State[1], b); |
| inc(State[2], c); |
| inc(State[3], d); |
| end; |
| // ----------------------------------------------------------------------------------------------- |
| // Initialize given Context |
| procedure MD5Init(var Context: MD5Context); |
| begin |
| with Context do begin |
| State[0] := $67452301; |
| State[1] := $efcdab89; |
| State[2] := $98badcfe; |
| State[3] := $10325476; |
| Count[0] := 0; |
| Count[1] := 0; |
| ZeroMemory(@Buffer, SizeOf(MD5Buffer)); |
| end; |
| end; |
| // Update given Context to include Length bytes of Input |
| procedure MD5Update(var Context: MD5Context; Input: pChar; Length: longword); |
| var |
| Index: longword; |
| PartLen: longword; |
| I: longword; |
| begin |
| with Context do begin |
| Index := (Count[0] shr 3) and $3f; |
| inc(Count[0], Length shl 3); |
| if Count[0] < (Length shl 3) then inc(Count[1]); |
| inc(Count[1], Length shr 29); |
| end; |
| PartLen := 64 - Index; |
| if Length >= PartLen then begin |
| CopyMemory(@Context.Buffer[Index], Input, PartLen); |
| Transform(@Context.Buffer, Context.State); |
| I := PartLen; |
| while I + 63 < Length do begin |
| Transform(@Input[I], Context.State); |
| inc(I, 64); |
| end; |
| Index := 0; |
| end else I := 0; |
| CopyMemory(@Context.Buffer[Index], @Input[I], Length - I); |
| end; |
| // Finalize given Context, create Digest and zeroize Context |
| procedure MD5Final(var Context: MD5Context; var Digest: MD5Digest); |
| var |
| Bits: MD5CBits; |
| Index: longword; |
| PadLen: longword; |
| begin |
| Decode(@Context.Count, @Bits, 2); |
| Index := (Context.Count[0] shr 3) and $3f; |
| if Index < 56 then PadLen := 56 - Index else PadLen := 120 - Index; |
| MD5Update(Context, @PADDING, PadLen); |
| MD5Update(Context, @Bits, 8); |
| Decode(@Context.State, @Digest, 4); |
| ZeroMemory(@Context, SizeOf(MD5Context)); |
| end; |
| // ----------------------------------------------------------------------------------------------- |
| // Create digest of given Message |
| function MD5String(M: string): MD5Digest; |
| var |
| Context: MD5Context; |
| begin |
| MD5Init(Context); |
| MD5Update(Context, pChar(M), length(M)); |
| MD5Final(Context, Result); |
| end; |
| // Create digest of file with given Name |
| function MD5File(N: string): MD5Digest; |
| var |
| FileHandle: THandle; |
| MapHandle: THandle; |
| ViewPointer: pointer; |
| Context: MD5Context; |
| begin |
| MD5Init(Context); |
| FileHandle := CreateFile(pChar(N), GENERIC_READ, FILE_SHARE_READ or FILE_SHARE_WRITE, |
| nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL or FILE_FLAG_SEQUENTIAL_SCAN, 0); |
| if FileHandle <> INVALID_HANDLE_VALUE then try |
| MapHandle := CreateFileMapping(FileHandle, nil, PAGE_READONLY, 0, 0, nil); |
| if MapHandle <> 0 then try |
| ViewPointer := MapViewOfFile(MapHandle, FILE_MAP_READ, 0, 0, 0); |
| if ViewPointer <> nil then try |
| MD5Update(Context, ViewPointer, GetFileSize(FileHandle, nil)); |
| finally |
| UnmapViewOfFile(ViewPointer); |
| end; |
| finally |
| CloseHandle(MapHandle); |
| end; |
| finally |
| CloseHandle(FileHandle); |
| end; |
| MD5Final(Context, Result); |
| end; |
| // Create hex representation of given Digest |
| function MD5Print(D: MD5Digest): string; |
| var |
| I: byte; |
| const |
| Digits: array[0..15] of char = |
| ('0', '1', '2', '3', '4', '5', '6', '7', '8', '9', 'a', 'b', 'c', 'd', 'e', 'f'); |
| begin |
| Result := ''; |
| for I := 0 to 15 do Result := Result + Digits[(D[I] shr 4) and $0f] + Digits[D[I] and $0f]; |
| end; |
| // ----------------------------------------------------------------------------------------------- |
| // Compare two Digests |
| function MD5Match(D1, D2: MD5Digest): boolean; |
| var |
| I: byte; |
| begin |
| I := 0; |
| Result := TRUE; |
| while Result and (I < 16) do begin |
| Result := D1[I] = D2[I]; |
| inc(I); |
| end; |
| end; |
| end. |
| /DosLineConv/PosEx.pas |
|---|
| 0,0 → 1,371 |
| unit PosEx; |
| // © 1997-2005 by FNS Enterprize's |
| // 2003-2005 by himitsu @ Delphi-PRAXiS |
| // http://www.delphipraxis.net/topic61002,0,asc,0.html |
| interface |
| Function _Pos (Const SubStr, S: AnsiString): LongInt; overload; |
| Function _Pos (Const SubStr, S: WideString): LongInt; overload; |
| Function _PosEx (Const SubStr, S: AnsiString; Offset: LongInt = 1): LongInt; overload; |
| Function _PosEx (Const SubStr, S: WideString; Offset: LongInt = 1): LongInt; overload; |
| Function CountString(Const SubStr, S: AnsiString): Word; overload; |
| Function CountString(Const SubStr, S: WideString): Word; overload; |
| implementation |
| Function _Pos(Const SubStr, S: AnsiString): LongInt; |
| ASM |
| PUSH ESI |
| PUSH EDI |
| PUSH EBX |
| TEST &SubStr, &SubStr |
| JE @Exit |
| TEST &S, &S |
| JE @Exit0 |
| MOV ESI, &SubStr |
| MOV EDI, &S |
| PUSH EDI |
| MOV ECX, [EDI - 4] |
| MOV EDX, [ESI - 4] |
| DEC EDX |
| JS @Fail |
| MOV AL, [ESI] |
| INC ESI |
| SUB ECX, EDX |
| JLE @Fail |
| @Loop: |
| REPNE SCASB |
| JNE @Fail |
| MOV EBX, ECX |
| PUSH ESI |
| PUSH EDI |
| MOV ECX, EDX |
| REPE CMPSB |
| POP EDI |
| POP ESI |
| JE @Found |
| MOV ECX, EBX |
| JMP @Loop |
| @Fail: |
| POP EDX |
| @Exit0: |
| XOR EAX, EAX |
| JMP @Exit |
| @Found: |
| POP EDX |
| MOV EAX, EDI |
| SUB EAX, EDX |
| @Exit: |
| POP EBX |
| POP EDI |
| POP ESI |
| End; |
| Function _Pos(Const SubStr, S: WideString): LongInt; |
| ASM |
| PUSH ESI |
| PUSH EDI |
| PUSH EBX |
| TEST &SubStr, &SubStr |
| JE @Exit |
| TEST &S, &S |
| JE @Exit0 |
| MOV ESI, &SubStr |
| MOV EDI, &S |
| PUSH EDI |
| MOV ECX, [EDI - 4] |
| SAL EAX, 1 |
| MOV EDX, [ESI - 4] |
| SAL EDX, 1 |
| DEC EDX |
| JS @Fail |
| MOV AX, [ESI] |
| ADD ESI, 2 |
| SUB ECX, EDX |
| JLE @Fail |
| @Loop: |
| REPNE SCASW |
| JNE @Fail |
| MOV EBX, ECX |
| PUSH ESI |
| PUSH EDI |
| MOV ECX, EDX |
| REPE CMPSW |
| POP EDI |
| POP ESI |
| JE @Found |
| MOV ECX, EBX |
| JMP @Loop |
| @Fail: |
| POP EDX |
| @Exit0: |
| XOR EAX, EAX |
| JMP @Exit |
| @Found: |
| POP EDX |
| MOV EAX, EDI |
| SUB EAX, EDX |
| SHR EAX, 1 |
| @Exit: |
| POP EBX |
| POP EDI |
| POP ESI |
| End; |
| Function _PosEx(Const SubStr, S: AnsiString; Offset: LongInt = 1): LongInt; |
| ASM |
| PUSH ESI |
| PUSH EDI |
| PUSH EBX |
| TEST &SubStr, &SubStr |
| JE @Exit |
| TEST &S, &S |
| JE @Exit0 |
| TEST &Offset, &Offset |
| JG @POff |
| MOV &Offset, 1 |
| @POff: |
| MOV ESI, &SubStr |
| MOV EDI, &S |
| PUSH EDI |
| MOV EAX, &Offset |
| DEC EAX |
| MOV ECX, [EDI - 4] |
| MOV EDX, [ESI - 4] |
| DEC EDX |
| JS @Fail |
| SUB ECX, EAX |
| ADD EDI, EAX |
| MOV AL, [ESI] |
| INC ESI |
| SUB ECX, EDX |
| JLE @Fail |
| @Loop: |
| REPNE SCASB |
| JNE @Fail |
| MOV EBX, ECX |
| PUSH ESI |
| PUSH EDI |
| MOV ECX, EDX |
| REPE CMPSB |
| POP EDI |
| POP ESI |
| JE @Found |
| MOV ECX, EBX |
| JMP @Loop |
| @Fail: |
| POP EDX |
| @Exit0: |
| XOR EAX, EAX |
| JMP @Exit |
| @Found: |
| POP EDX |
| MOV EAX, EDI |
| SUB EAX, EDX |
| @Exit: |
| POP EBX |
| POP EDI |
| POP ESI |
| End; |
| Function _PosEx(Const SubStr, S: WideString; Offset: LongInt = 1): LongInt; |
| ASM |
| PUSH ESI |
| PUSH EDI |
| PUSH EBX |
| TEST &SubStr, &SubStr |
| JE @Exit |
| TEST &S, &S |
| JE @Exit0 |
| TEST &Offset, &Offset |
| JG @POff |
| MOV &Offset, 1 |
| @POff: |
| MOV ESI, &SubStr |
| MOV EDI, &S |
| PUSH EDI |
| PUSH &Offset |
| MOV ECX, [EDI - 4] |
| SAL ECX, 1 |
| MOV EDX, [ESI - 4] |
| SAL EDX, 1 |
| POP EAX |
| DEC EAX |
| DEC EDX |
| JS @Fail |
| SUB ECX, EAX |
| ADD EDI, EAX |
| ADD EDI, EAX |
| MOV AX, [ESI] |
| ADD ESI, 2 |
| SUB ECX, EDX |
| JLE @Fail |
| @Loop: |
| REPNE SCASW |
| JNE @Fail |
| MOV EBX, ECX |
| PUSH ESI |
| PUSH EDI |
| MOV ECX, EDX |
| REPE CMPSW |
| POP EDI |
| POP ESI |
| JE @Found |
| MOV ECX, EBX |
| JMP @Loop |
| @Fail: |
| POP EDX |
| @Exit0: |
| XOR EAX, EAX |
| JMP @Exit |
| @Found: |
| POP EDX |
| MOV EAX, EDI |
| SUB EAX, EDX |
| SHR EAX, 1 |
| @Exit: |
| POP EBX |
| POP EDI |
| POP ESI |
| End; |
| Function CountString(Const SubStr, S: AnsiString): Word; |
| ASM |
| PUSH ESI |
| PUSH EDI |
| PUSH EBX |
| TEST &SubStr, &SubStr |
| JE @Exit |
| TEST &S, &S |
| JE @Exit0 |
| MOV ESI, &SubStr |
| MOV EDI, &S |
| PUSH EDI |
| MOV ECX, [EDI - 4] |
| MOV EDX, [ESI - 4] |
| DEC EDX |
| JS @Fail |
| XOR EAX, EAX |
| MOV AL, [ESI] |
| INC ESI |
| SUB ECX, EDX |
| JLE @Fail |
| @Loop: |
| REPNE SCASB |
| JNE @Ready |
| MOV EBX, ECX |
| PUSH ESI |
| PUSH EDI |
| MOV ECX, EDX |
| REPE CMPSB |
| POP EDI |
| POP ESI |
| JNE @noInc |
| CMP EAX, $FFFF0000 |
| JAE @Ready |
| ADD EAX, $00010000 |
| @noInc: |
| MOV ECX, EBX |
| JMP @Loop |
| @Fail: |
| POP EDX |
| @Exit0: |
| XOR EAX, EAX |
| JMP @Exit |
| @Ready: |
| POP EDX |
| SHR EAX, 16 |
| @Exit: |
| POP EBX |
| POP EDI |
| POP ESI |
| End; |
| Function CountString(Const SubStr, S: WideString): Word; |
| ASM |
| PUSH ESI |
| PUSH EDI |
| PUSH EBX |
| TEST &SubStr, &SubStr |
| JE @Exit |
| TEST &S, &S |
| JE @Exit0 |
| MOV ESI, &SubStr |
| MOV EDI, &S |
| PUSH EDI |
| MOV ECX, [EDI - 4] |
| SAL ECX, 1 |
| MOV EDX, [ESI - 4] |
| SAL EDX, 1 |
| DEC EDX |
| JS @Fail |
| XOR EAX, EAX |
| MOV AX, [ESI] |
| ADD ESI, 2 |
| SUB ECX, EDX |
| JLE @Fail |
| @Loop: |
| REPNE SCASW |
| JNE @Ready |
| MOV EBX, ECX |
| PUSH ESI |
| PUSH EDI |
| MOV ECX, EDX |
| REPE CMPSW |
| POP EDI |
| POP ESI |
| JNE @noInc |
| CMP EAX, $FFFF0000 |
| JAE @Ready |
| ADD EAX, $00010000 |
| @noInc: |
| MOV ECX, EBX |
| JMP @Loop |
| @Fail: |
| POP EDX |
| @Exit0: |
| XOR EAX, EAX |
| JMP @Exit |
| @Ready: |
| POP EDX |
| SHR EAX, 16 |
| @Exit: |
| POP EBX |
| POP EDI |
| POP ESI |
| End; |
| end. |
| /DosLineConv/BinarySafeReplace.pas |
|---|
| 0,0 → 1,114 |
| unit BinarySafeReplace; |
| // BinarySafeReplace.pas |
| // Version 1.1 |
| // by Daniel Marschall |
| // http://www.delphipraxis.net/post778431.html |
| interface |
| uses |
| StrUtils, SysUtils, Classes; |
| // Binary-Safe. Der Parameter AString wird direkt ersetzt. |
| // Die Anzahl der durchgefühten Ersetzungen wird als Ergebnis zurückgegeben. |
| function StringReplacesBinarySafe(var AString: string; const ASearchPattern, AReplaceWith: string): integer; |
| // Direkter Ersatz für StringReplace(), Binary-Safe. |
| // Veränderter String wird als Eregebnis zurückgegeben. |
| function StringReplaceBinarySafe(const AString, ASearchPattern, AReplaceWith: string): string; |
| // BinarySafeReplaceFileContents |
| // Die Anzahl der durchgefühten Ersetzungen wird als Ergebnis zurückgegeben. |
| function BinarySafeReplaceFileContents(const AInputFile, AOutputFile, ASearchPattern, AReplaceWith: string): integer; |
| implementation |
| uses |
| PosEx; |
| function StringReplacesBinarySafe(var AString: string; const ASearchPattern, AReplaceWith: string): integer; |
| var |
| iPos: Integer; |
| lastpos: Integer; |
| ueberhang: integer; |
| begin |
| result := 0; |
| if AString = '' then exit; |
| if ASearchPattern = '' then exit; |
| UniqueString(AString); // Referenzzählung beachten. Dank an shmia für den Hinweis. |
| ueberhang := length(AReplaceWith) - length(ASearchPattern); |
| lastpos := 1; |
| while true do |
| begin |
| iPos := _PosEx(ASearchPattern, AString, lastpos); |
| if iPos <= 0 then break; |
| if result = 7 then |
| if Pred(iPos) > Length(AString) - Length(AReplaceWith) + 1 {Bugfix, Added +1. Ersetzungen am StringEnde} then break; |
| if ueberhang > 0 then |
| begin |
| setlength(AString, length(AString)+ueberhang); |
| Move(AString[iPos], AString[iPos+ueberhang], length(AString)-iPos); // Bugfix: Hier stand length(AString)-iPos-1 |
| end; |
| Move(AReplaceWith[1], AString[iPos], Length(AReplaceWith)); |
| if ueberhang < 0 then |
| begin |
| Move(AString[iPos+length(ASearchPattern)], AString[iPos+length(AReplaceWith)], length(AString)-iPos-length(AReplaceWith)); |
| setlength(AString, length(AString)+ueberhang); |
| ueberhang := -1; |
| end; |
| lastpos := iPos + ueberhang + 1; |
| inc(result); |
| end; |
| end; |
| function StringReplaceBinarySafe(const AString, ASearchPattern, AReplaceWith: string): string; |
| var |
| tmp: string; |
| begin |
| tmp := AString; |
| StringReplacesBinarySafe(tmp, ASearchPattern, AReplaceWith); |
| result := tmp; |
| end; |
| function BinarySafeReplaceFileContents(const AInputFile, AOutputFile, ASearchPattern, AReplaceWith: string): integer; |
| var |
| fst: TFileStream; |
| str: string; |
| begin |
| result := -1; |
| if not FileExists(AInputFile) then exit; |
| if not ForceDirectories(ExtractFilePath(AOutputFile)) then exit; |
| fst := TFileStream.Create(AInputFile, fmOpenRead or fmShareDenyWrite); |
| try |
| fst.Position := 0; |
| setlength(str, fst.Size); |
| fst.Read(str[1], fst.Size); |
| finally |
| fst.free; |
| end; |
| result := StringReplacesBinarySafe(str, ASearchPattern, AReplaceWith); |
| fst := TFileStream.Create(AOutputFile, fmCreate); |
| try |
| fst.Position := 0; |
| fst.Write(str[1], length(str)); |
| finally |
| fst.free; |
| end; |
| end; |
| end. |
| /DosLineConv/DosLineConv.cfg |
|---|
| 0,0 → 1,38 |
| -$A8 |
| -$B- |
| -$C+ |
| -$D+ |
| -$E- |
| -$F- |
| -$G+ |
| -$H+ |
| -$I+ |
| -$J- |
| -$K- |
| -$L+ |
| -$M- |
| -$N+ |
| -$O+ |
| -$P+ |
| -$Q- |
| -$R- |
| -$S- |
| -$T- |
| -$U- |
| -$V+ |
| -$W- |
| -$X+ |
| -$YD |
| -$Z1 |
| -cg |
| -AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; |
| -H+ |
| -W+ |
| -M |
| -$M16384,1048576 |
| -K$00400000 |
| -LE"C:\Dokumente und Einstellungen\Daniel Marschall\Eigene Dateien\Borland Studio-Projekte\Bpl" |
| -LN"C:\Dokumente und Einstellungen\Daniel Marschall\Eigene Dateien\Borland Studio-Projekte\Bpl" |
| -w-UNSAFE_TYPE |
| -w-UNSAFE_CODE |
| -w-UNSAFE_CAST |
| /DosLineConv/DosLineConv.exe |
|---|
| Cannot display: file marked as a binary type. |
| svn:mime-type = application/octet-stream |
| Property changes: |
| Added: svn:mime-type |
| +application/octet-stream |
| \ No newline at end of property |
| /DosLineConv/DosLineConv.bdsproj |
|---|
| 0,0 → 1,175 |
| <?xml version="1.0" encoding="utf-8"?> |
| <BorlandProject> |
| <PersonalityInfo> |
| <Option> |
| <Option Name="Personality">Delphi.Personality</Option> |
| <Option Name="ProjectType">VCLApplication</Option> |
| <Option Name="Version">1.0</Option> |
| <Option Name="GUID">{DB936C93-3752-4262-8D86-6EEA3B4C7FE2}</Option> |
| </Option> |
| </PersonalityInfo> |
| <Delphi.Personality> |
| <Source> |
| <Source Name="MainSource">DosLineConv.dpr</Source> |
| </Source> |
| <FileVersion> |
| <FileVersion Name="Version">7.0</FileVersion> |
| </FileVersion> |
| <Compiler> |
| <Compiler Name="A">8</Compiler> |
| <Compiler Name="B">0</Compiler> |
| <Compiler Name="C">1</Compiler> |
| <Compiler Name="D">1</Compiler> |
| <Compiler Name="E">0</Compiler> |
| <Compiler Name="F">0</Compiler> |
| <Compiler Name="G">1</Compiler> |
| <Compiler Name="H">1</Compiler> |
| <Compiler Name="I">1</Compiler> |
| <Compiler Name="J">0</Compiler> |
| <Compiler Name="K">0</Compiler> |
| <Compiler Name="L">1</Compiler> |
| <Compiler Name="M">0</Compiler> |
| <Compiler Name="N">1</Compiler> |
| <Compiler Name="O">1</Compiler> |
| <Compiler Name="P">1</Compiler> |
| <Compiler Name="Q">0</Compiler> |
| <Compiler Name="R">0</Compiler> |
| <Compiler Name="S">0</Compiler> |
| <Compiler Name="T">0</Compiler> |
| <Compiler Name="U">0</Compiler> |
| <Compiler Name="V">1</Compiler> |
| <Compiler Name="W">0</Compiler> |
| <Compiler Name="X">1</Compiler> |
| <Compiler Name="Y">1</Compiler> |
| <Compiler Name="Z">1</Compiler> |
| <Compiler Name="ShowHints">True</Compiler> |
| <Compiler Name="ShowWarnings">True</Compiler> |
| <Compiler Name="UnitAliases">WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;</Compiler> |
| <Compiler Name="NamespacePrefix"></Compiler> |
| <Compiler Name="GenerateDocumentation">False</Compiler> |
| <Compiler Name="DefaultNamespace"></Compiler> |
| <Compiler Name="SymbolDeprecated">True</Compiler> |
| <Compiler Name="SymbolLibrary">True</Compiler> |
| <Compiler Name="SymbolPlatform">True</Compiler> |
| <Compiler Name="SymbolExperimental">True</Compiler> |
| <Compiler Name="UnitLibrary">True</Compiler> |
| <Compiler Name="UnitPlatform">True</Compiler> |
| <Compiler Name="UnitDeprecated">True</Compiler> |
| <Compiler Name="UnitExperimental">True</Compiler> |
| <Compiler Name="HResultCompat">True</Compiler> |
| <Compiler Name="HidingMember">True</Compiler> |
| <Compiler Name="HiddenVirtual">True</Compiler> |
| <Compiler Name="Garbage">True</Compiler> |
| <Compiler Name="BoundsError">True</Compiler> |
| <Compiler Name="ZeroNilCompat">True</Compiler> |
| <Compiler Name="StringConstTruncated">True</Compiler> |
| <Compiler Name="ForLoopVarVarPar">True</Compiler> |
| <Compiler Name="TypedConstVarPar">True</Compiler> |
| <Compiler Name="AsgToTypedConst">True</Compiler> |
| <Compiler Name="CaseLabelRange">True</Compiler> |
| <Compiler Name="ForVariable">True</Compiler> |
| <Compiler Name="ConstructingAbstract">True</Compiler> |
| <Compiler Name="ComparisonFalse">True</Compiler> |
| <Compiler Name="ComparisonTrue">True</Compiler> |
| <Compiler Name="ComparingSignedUnsigned">True</Compiler> |
| <Compiler Name="CombiningSignedUnsigned">True</Compiler> |
| <Compiler Name="UnsupportedConstruct">True</Compiler> |
| <Compiler Name="FileOpen">True</Compiler> |
| <Compiler Name="FileOpenUnitSrc">True</Compiler> |
| <Compiler Name="BadGlobalSymbol">True</Compiler> |
| <Compiler Name="DuplicateConstructorDestructor">True</Compiler> |
| <Compiler Name="InvalidDirective">True</Compiler> |
| <Compiler Name="PackageNoLink">True</Compiler> |
| <Compiler Name="PackageThreadVar">True</Compiler> |
| <Compiler Name="ImplicitImport">True</Compiler> |
| <Compiler Name="HPPEMITIgnored">True</Compiler> |
| <Compiler Name="NoRetVal">True</Compiler> |
| <Compiler Name="UseBeforeDef">True</Compiler> |
| <Compiler Name="ForLoopVarUndef">True</Compiler> |
| <Compiler Name="UnitNameMismatch">True</Compiler> |
| <Compiler Name="NoCFGFileFound">True</Compiler> |
| <Compiler Name="ImplicitVariants">True</Compiler> |
| <Compiler Name="UnicodeToLocale">True</Compiler> |
| <Compiler Name="LocaleToUnicode">True</Compiler> |
| <Compiler Name="ImagebaseMultiple">True</Compiler> |
| <Compiler Name="SuspiciousTypecast">True</Compiler> |
| <Compiler Name="PrivatePropAccessor">True</Compiler> |
| <Compiler Name="UnsafeType">False</Compiler> |
| <Compiler Name="UnsafeCode">False</Compiler> |
| <Compiler Name="UnsafeCast">False</Compiler> |
| <Compiler Name="OptionTruncated">True</Compiler> |
| <Compiler Name="WideCharReduced">True</Compiler> |
| <Compiler Name="DuplicatesIgnored">True</Compiler> |
| <Compiler Name="UnitInitSeq">True</Compiler> |
| <Compiler Name="LocalPInvoke">True</Compiler> |
| <Compiler Name="MessageDirective">True</Compiler> |
| <Compiler Name="CodePage"></Compiler> |
| </Compiler> |
| <Linker> |
| <Linker Name="MapFile">0</Linker> |
| <Linker Name="OutputObjs">0</Linker> |
| <Linker Name="GenerateHpps">False</Linker> |
| <Linker Name="ConsoleApp">1</Linker> |
| <Linker Name="DebugInfo">False</Linker> |
| <Linker Name="RemoteSymbols">False</Linker> |
| <Linker Name="GenerateDRC">False</Linker> |
| <Linker Name="MinStackSize">16384</Linker> |
| <Linker Name="MaxStackSize">1048576</Linker> |
| <Linker Name="ImageBase">4194304</Linker> |
| <Linker Name="ExeDescription"></Linker> |
| </Linker> |
| <Directories> |
| <Directories Name="OutputDir"></Directories> |
| <Directories Name="UnitOutputDir"></Directories> |
| <Directories Name="PackageDLLOutputDir"></Directories> |
| <Directories Name="PackageDCPOutputDir"></Directories> |
| <Directories Name="SearchPath"></Directories> |
| <Directories Name="Packages"></Directories> |
| <Directories Name="Conditionals"></Directories> |
| <Directories Name="DebugSourceDirs"></Directories> |
| <Directories Name="UsePackages">False</Directories> |
| </Directories> |
| <Parameters> |
| <Parameters Name="RunParams"></Parameters> |
| <Parameters Name="HostApplication"></Parameters> |
| <Parameters Name="Launcher"></Parameters> |
| <Parameters Name="UseLauncher">False</Parameters> |
| <Parameters Name="DebugCWD"></Parameters> |
| <Parameters Name="Debug Symbols Search Path"></Parameters> |
| <Parameters Name="LoadAllSymbols">True</Parameters> |
| <Parameters Name="LoadUnspecifiedSymbols">False</Parameters> |
| </Parameters> |
| <Language> |
| <Language Name="ActiveLang"></Language> |
| <Language Name="ProjectLang">$00000000</Language> |
| <Language Name="RootDir"></Language> |
| </Language> |
| <VersionInfo> |
| <VersionInfo Name="IncludeVerInfo">False</VersionInfo> |
| <VersionInfo Name="AutoIncBuild">False</VersionInfo> |
| <VersionInfo Name="MajorVer">1</VersionInfo> |
| <VersionInfo Name="MinorVer">0</VersionInfo> |
| <VersionInfo Name="Release">0</VersionInfo> |
| <VersionInfo Name="Build">0</VersionInfo> |
| <VersionInfo Name="Debug">False</VersionInfo> |
| <VersionInfo Name="PreRelease">False</VersionInfo> |
| <VersionInfo Name="Special">False</VersionInfo> |
| <VersionInfo Name="Private">False</VersionInfo> |
| <VersionInfo Name="DLL">False</VersionInfo> |
| <VersionInfo Name="Locale">1031</VersionInfo> |
| <VersionInfo Name="CodePage">1252</VersionInfo> |
| </VersionInfo> |
| <VersionInfoKeys> |
| <VersionInfoKeys Name="CompanyName"></VersionInfoKeys> |
| <VersionInfoKeys Name="FileDescription"></VersionInfoKeys> |
| <VersionInfoKeys Name="FileVersion">1.0.0.0</VersionInfoKeys> |
| <VersionInfoKeys Name="InternalName"></VersionInfoKeys> |
| <VersionInfoKeys Name="LegalCopyright"></VersionInfoKeys> |
| <VersionInfoKeys Name="LegalTrademarks"></VersionInfoKeys> |
| <VersionInfoKeys Name="OriginalFilename"></VersionInfoKeys> |
| <VersionInfoKeys Name="ProductName"></VersionInfoKeys> |
| <VersionInfoKeys Name="ProductVersion">1.0.0.0</VersionInfoKeys> |
| <VersionInfoKeys Name="Comments"></VersionInfoKeys> |
| </VersionInfoKeys> |
| </Delphi.Personality> |
| </BorlandProject> |
| /DosLineConv/DosLineConv.dpr |
|---|
| 0,0 → 1,109 |
| program DosLineConv; |
| uses |
| SysUtils, |
| Classes, |
| Dialogs, |
| Windows, |
| BinarySafeReplace in 'BinarySafeReplace.pas', |
| PosEx in 'PosEx.pas'; |
| {$R *.res} |
| var |
| f: string; |
| const |
| target_format = #13#10; |
| type |
| EMoveError = class(Exception); |
| resourcestring |
| lng_file_not_found = 'The file "%s" was not found!'; |
| lng_is_a_dir = 'MD5 checksum can only calculated for files.'; |
| lng_binary_error = 'File "%s" has binary contents! You should only edit ASCII files.'; |
| lng_syntax = 'Syntax: %s filename'; |
| lng_error = 'An error occoured! Probably the file can''t be overwritten.'; |
| procedure NormalizeLineBreaks(f, seq: string); |
| var |
| t: string; |
| begin |
| t := f+'~'; // Zwischenschritte schonen die Originaldatei (z.B. bei Fehlern) |
| DeleteFile(PChar(t)); |
| BinarySafeReplaceFileContents(f, t, #13#10, #13); // Windows format |
| // BinarySafeReplaceFileContents(t, t, #10#13, #13); |
| BinarySafeReplaceFileContents(t, t, #10, #13); // MAC format |
| BinarySafeReplaceFileContents(t, t, #13, seq); // Linux format |
| DeleteFile(PChar(f)); |
| if not MoveFile(PChar(t), PChar(f)) then |
| begin |
| DeleteFile(PChar(t)); |
| raise EMoveError.Create(lng_error); |
| end; |
| end; |
| function IsBinaryFile(f: string): boolean; |
| var |
| Stream: TStream; |
| b: Byte; |
| begin |
| result := false; |
| Stream := TFileStream.Create(f, fmOpenRead); |
| try |
| while Stream.Read(b, SizeOf(b)) > 0 do |
| begin |
| if (b <= 31) and (b <> 9) and (b <> 10) and (b <> 13) then |
| begin |
| result := true; |
| Exit; |
| end; |
| end; |
| finally |
| Stream.Free; |
| end; |
| end; |
| var |
| i: integer; |
| begin |
| if ParamCount() < 1 then |
| begin |
| ShowMessageFmt(lng_syntax, [ExtractFileName(ParamStr(0))]); |
| Exit; |
| end; |
| for i := 1 to ParamCount() do |
| begin |
| f := ParamStr(i); |
| if DirectoryExists(f) then |
| begin |
| ShowMessage(lng_is_a_dir); |
| end |
| else |
| begin |
| if not FileExists(f) then |
| begin |
| ShowMessageFmt(lng_file_not_found, [f]); |
| end |
| else |
| begin |
| if IsBinaryFile(f) then |
| begin |
| ShowMessageFmt(lng_binary_error, [f]); |
| end |
| else |
| begin |
| try |
| NormalizeLineBreaks(f, #13#10); |
| except |
| ShowMessage(lng_error); |
| end; |
| end; |
| end; |
| end; |
| end; |
| end. |
| /DosLineConv/PosEx.dcu |
|---|
| Cannot display: file marked as a binary type. |
| svn:mime-type = application/octet-stream |
| Property changes: |
| Added: svn:mime-type |
| +application/octet-stream |
| \ No newline at end of property |
| /DosLineConv/BinarySafeReplace.dcu |
|---|
| Cannot display: file marked as a binary type. |
| svn:mime-type = application/octet-stream |
| Property changes: |
| Added: svn:mime-type |
| +application/octet-stream |
| \ No newline at end of property |
| /DosLineConv/Unit1.dcu |
|---|
| Cannot display: file marked as a binary type. |
| svn:mime-type = application/octet-stream |
| Property changes: |
| Added: svn:mime-type |
| +application/octet-stream |
| \ No newline at end of property |
| /DosLineConv/DosLineConv.dof |
|---|
| 0,0 → 1,87 |
| [FileVersion] |
| Version=6.0 |
| [Compiler] |
| A=8 |
| B=0 |
| C=1 |
| D=1 |
| E=0 |
| F=0 |
| G=1 |
| H=1 |
| I=1 |
| J=0 |
| K=0 |
| L=1 |
| M=0 |
| N=1 |
| O=1 |
| P=1 |
| Q=0 |
| R=0 |
| S=0 |
| T=0 |
| U=0 |
| V=1 |
| W=0 |
| X=1 |
| Y=1 |
| Z=1 |
| ShowHints=1 |
| ShowWarnings=1 |
| UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; |
| [Linker] |
| MapFile=0 |
| OutputObjs=0 |
| ConsoleApp=1 |
| DebugInfo=0 |
| RemoteSymbols=0 |
| MinStackSize=16384 |
| MaxStackSize=1048576 |
| ImageBase=4194304 |
| ExeDescription= |
| [Directories] |
| OutputDir= |
| UnitOutputDir= |
| PackageDLLOutputDir= |
| PackageDCPOutputDir= |
| SearchPath= |
| Packages= |
| Conditionals= |
| DebugSourceDirs= |
| UsePackages=0 |
| [Parameters] |
| RunParams= |
| HostApplication= |
| Launcher= |
| UseLauncher=0 |
| DebugCWD= |
| [Language] |
| ActiveLang= |
| ProjectLang= |
| RootDir= |
| [Version Info] |
| IncludeVerInfo=0 |
| AutoIncBuild=0 |
| MajorVer=1 |
| MinorVer=0 |
| Release=0 |
| Build=0 |
| Debug=0 |
| PreRelease=0 |
| Special=0 |
| Private=0 |
| DLL=0 |
| Locale=1031 |
| CodePage=1252 |
| [Version Info Keys] |
| CompanyName= |
| FileDescription= |
| FileVersion=1.0.0.0 |
| InternalName= |
| LegalCopyright= |
| LegalTrademarks= |
| OriginalFilename= |
| ProductName= |
| ProductVersion=1.0.0.0 |
| Comments= |
| /DosLineConv/DosLineConv.res |
|---|
| Cannot display: file marked as a binary type. |
| svn:mime-type = application/octet-stream |
| Property changes: |
| Added: svn:mime-type |
| +application/octet-stream |
| \ No newline at end of property |
| /FileMD5/FileMD5Main.dfm |
|---|
| 0,0 → 1,52 |
| object Form1: TForm1 |
| Left = 192 |
| Top = 113 |
| BorderIcons = [biSystemMenu, biMinimize] |
| BorderStyle = bsSingle |
| Caption = 'Quick MD5 Calc' |
| ClientHeight = 105 |
| ClientWidth = 289 |
| Color = clBtnFace |
| Font.Charset = DEFAULT_CHARSET |
| Font.Color = clWindowText |
| Font.Height = -11 |
| Font.Name = 'MS Sans Serif' |
| Font.Style = [] |
| OldCreateOrder = False |
| Position = poDesktopCenter |
| OnShow = FormShow |
| PixelsPerInch = 96 |
| TextHeight = 13 |
| object Label1: TLabel |
| Left = 8 |
| Top = 8 |
| Width = 32 |
| Height = 13 |
| Caption = 'Label1' |
| end |
| object Label2: TLabel |
| Left = 8 |
| Top = 56 |
| Width = 76 |
| Height = 13 |
| Caption = 'MD5 Checksum' |
| end |
| object Edit1: TEdit |
| Left = 8 |
| Top = 72 |
| Width = 273 |
| Height = 21 |
| Color = clBtnFace |
| ReadOnly = True |
| TabOrder = 0 |
| end |
| object Edit2: TEdit |
| Left = 8 |
| Top = 24 |
| Width = 273 |
| Height = 21 |
| Color = clBtnFace |
| ReadOnly = True |
| TabOrder = 1 |
| end |
| end |
| /FileMD5/md5.dcu |
|---|
| Cannot display: file marked as a binary type. |
| svn:mime-type = application/octet-stream |
| Property changes: |
| Added: svn:mime-type |
| +application/octet-stream |
| \ No newline at end of property |
| /FileMD5/FileMD5Main.ddp |
|---|
| Cannot display: file marked as a binary type. |
| svn:mime-type = application/octet-stream |
| Property changes: |
| Added: svn:mime-type |
| +application/octet-stream |
| \ No newline at end of property |
| /FileMD5/FileMD5.cfg |
|---|
| 0,0 → 1,42 |
| -$A8 |
| -$B- |
| -$C+ |
| -$D+ |
| -$E- |
| -$F- |
| -$G+ |
| -$H+ |
| -$I+ |
| -$J- |
| -$K- |
| -$L+ |
| -$M- |
| -$N+ |
| -$O+ |
| -$P+ |
| -$Q- |
| -$R- |
| -$S- |
| -$T- |
| -$U- |
| -$V+ |
| -$W- |
| -$X+ |
| -$YD |
| -$Z1 |
| -cg |
| -AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; |
| -H+ |
| -W+ |
| -M |
| -$M16384,1048576 |
| -K$00400000 |
| -LE"C:\Dokumente und Einstellungen\Daniel Marschall\Eigene Dateien\Borland Studio-Projekte\Bpl" |
| -LN"C:\Dokumente und Einstellungen\Daniel Marschall\Eigene Dateien\Borland Studio-Projekte\Bpl" |
| -U"..\_Common" |
| -O"..\_Common" |
| -I"..\_Common" |
| -R"..\_Common" |
| -w-UNSAFE_TYPE |
| -w-UNSAFE_CODE |
| -w-UNSAFE_CAST |
| /FileMD5/FileMD5Main.dcu |
|---|
| Cannot display: file marked as a binary type. |
| svn:mime-type = application/octet-stream |
| Property changes: |
| Added: svn:mime-type |
| +application/octet-stream |
| \ No newline at end of property |
| /FileMD5/FileMD5.exe |
|---|
| Cannot display: file marked as a binary type. |
| svn:mime-type = application/octet-stream |
| Property changes: |
| Added: svn:mime-type |
| +application/octet-stream |
| \ No newline at end of property |
| /FileMD5/FileMD5.bdsproj |
|---|
| 0,0 → 1,175 |
| <?xml version="1.0" encoding="utf-8"?> |
| <BorlandProject> |
| <PersonalityInfo> |
| <Option> |
| <Option Name="Personality">Delphi.Personality</Option> |
| <Option Name="ProjectType">VCLApplication</Option> |
| <Option Name="Version">1.0</Option> |
| <Option Name="GUID">{1FE935C0-8FA6-41F5-8B96-44E3A519B281}</Option> |
| </Option> |
| </PersonalityInfo> |
| <Delphi.Personality> |
| <Source> |
| <Source Name="MainSource">FileMD5.dpr</Source> |
| </Source> |
| <FileVersion> |
| <FileVersion Name="Version">7.0</FileVersion> |
| </FileVersion> |
| <Compiler> |
| <Compiler Name="A">8</Compiler> |
| <Compiler Name="B">0</Compiler> |
| <Compiler Name="C">1</Compiler> |
| <Compiler Name="D">1</Compiler> |
| <Compiler Name="E">0</Compiler> |
| <Compiler Name="F">0</Compiler> |
| <Compiler Name="G">1</Compiler> |
| <Compiler Name="H">1</Compiler> |
| <Compiler Name="I">1</Compiler> |
| <Compiler Name="J">0</Compiler> |
| <Compiler Name="K">0</Compiler> |
| <Compiler Name="L">1</Compiler> |
| <Compiler Name="M">0</Compiler> |
| <Compiler Name="N">1</Compiler> |
| <Compiler Name="O">1</Compiler> |
| <Compiler Name="P">1</Compiler> |
| <Compiler Name="Q">0</Compiler> |
| <Compiler Name="R">0</Compiler> |
| <Compiler Name="S">0</Compiler> |
| <Compiler Name="T">0</Compiler> |
| <Compiler Name="U">0</Compiler> |
| <Compiler Name="V">1</Compiler> |
| <Compiler Name="W">0</Compiler> |
| <Compiler Name="X">1</Compiler> |
| <Compiler Name="Y">1</Compiler> |
| <Compiler Name="Z">1</Compiler> |
| <Compiler Name="ShowHints">True</Compiler> |
| <Compiler Name="ShowWarnings">True</Compiler> |
| <Compiler Name="UnitAliases">WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;</Compiler> |
| <Compiler Name="NamespacePrefix"></Compiler> |
| <Compiler Name="GenerateDocumentation">False</Compiler> |
| <Compiler Name="DefaultNamespace"></Compiler> |
| <Compiler Name="SymbolDeprecated">True</Compiler> |
| <Compiler Name="SymbolLibrary">True</Compiler> |
| <Compiler Name="SymbolPlatform">True</Compiler> |
| <Compiler Name="SymbolExperimental">True</Compiler> |
| <Compiler Name="UnitLibrary">True</Compiler> |
| <Compiler Name="UnitPlatform">True</Compiler> |
| <Compiler Name="UnitDeprecated">True</Compiler> |
| <Compiler Name="UnitExperimental">True</Compiler> |
| <Compiler Name="HResultCompat">True</Compiler> |
| <Compiler Name="HidingMember">True</Compiler> |
| <Compiler Name="HiddenVirtual">True</Compiler> |
| <Compiler Name="Garbage">True</Compiler> |
| <Compiler Name="BoundsError">True</Compiler> |
| <Compiler Name="ZeroNilCompat">True</Compiler> |
| <Compiler Name="StringConstTruncated">True</Compiler> |
| <Compiler Name="ForLoopVarVarPar">True</Compiler> |
| <Compiler Name="TypedConstVarPar">True</Compiler> |
| <Compiler Name="AsgToTypedConst">True</Compiler> |
| <Compiler Name="CaseLabelRange">True</Compiler> |
| <Compiler Name="ForVariable">True</Compiler> |
| <Compiler Name="ConstructingAbstract">True</Compiler> |
| <Compiler Name="ComparisonFalse">True</Compiler> |
| <Compiler Name="ComparisonTrue">True</Compiler> |
| <Compiler Name="ComparingSignedUnsigned">True</Compiler> |
| <Compiler Name="CombiningSignedUnsigned">True</Compiler> |
| <Compiler Name="UnsupportedConstruct">True</Compiler> |
| <Compiler Name="FileOpen">True</Compiler> |
| <Compiler Name="FileOpenUnitSrc">True</Compiler> |
| <Compiler Name="BadGlobalSymbol">True</Compiler> |
| <Compiler Name="DuplicateConstructorDestructor">True</Compiler> |
| <Compiler Name="InvalidDirective">True</Compiler> |
| <Compiler Name="PackageNoLink">True</Compiler> |
| <Compiler Name="PackageThreadVar">True</Compiler> |
| <Compiler Name="ImplicitImport">True</Compiler> |
| <Compiler Name="HPPEMITIgnored">True</Compiler> |
| <Compiler Name="NoRetVal">True</Compiler> |
| <Compiler Name="UseBeforeDef">True</Compiler> |
| <Compiler Name="ForLoopVarUndef">True</Compiler> |
| <Compiler Name="UnitNameMismatch">True</Compiler> |
| <Compiler Name="NoCFGFileFound">True</Compiler> |
| <Compiler Name="ImplicitVariants">True</Compiler> |
| <Compiler Name="UnicodeToLocale">True</Compiler> |
| <Compiler Name="LocaleToUnicode">True</Compiler> |
| <Compiler Name="ImagebaseMultiple">True</Compiler> |
| <Compiler Name="SuspiciousTypecast">True</Compiler> |
| <Compiler Name="PrivatePropAccessor">True</Compiler> |
| <Compiler Name="UnsafeType">False</Compiler> |
| <Compiler Name="UnsafeCode">False</Compiler> |
| <Compiler Name="UnsafeCast">False</Compiler> |
| <Compiler Name="OptionTruncated">True</Compiler> |
| <Compiler Name="WideCharReduced">True</Compiler> |
| <Compiler Name="DuplicatesIgnored">True</Compiler> |
| <Compiler Name="UnitInitSeq">True</Compiler> |
| <Compiler Name="LocalPInvoke">True</Compiler> |
| <Compiler Name="MessageDirective">True</Compiler> |
| <Compiler Name="CodePage"></Compiler> |
| </Compiler> |
| <Linker> |
| <Linker Name="MapFile">0</Linker> |
| <Linker Name="OutputObjs">0</Linker> |
| <Linker Name="GenerateHpps">False</Linker> |
| <Linker Name="ConsoleApp">1</Linker> |
| <Linker Name="DebugInfo">False</Linker> |
| <Linker Name="RemoteSymbols">False</Linker> |
| <Linker Name="GenerateDRC">False</Linker> |
| <Linker Name="MinStackSize">16384</Linker> |
| <Linker Name="MaxStackSize">1048576</Linker> |
| <Linker Name="ImageBase">4194304</Linker> |
| <Linker Name="ExeDescription"></Linker> |
| </Linker> |
| <Directories> |
| <Directories Name="OutputDir"></Directories> |
| <Directories Name="UnitOutputDir"></Directories> |
| <Directories Name="PackageDLLOutputDir"></Directories> |
| <Directories Name="PackageDCPOutputDir"></Directories> |
| <Directories Name="SearchPath">..\_Common</Directories> |
| <Directories Name="Packages"></Directories> |
| <Directories Name="Conditionals"></Directories> |
| <Directories Name="DebugSourceDirs"></Directories> |
| <Directories Name="UsePackages">False</Directories> |
| </Directories> |
| <Parameters> |
| <Parameters Name="RunParams"></Parameters> |
| <Parameters Name="HostApplication"></Parameters> |
| <Parameters Name="Launcher"></Parameters> |
| <Parameters Name="UseLauncher">False</Parameters> |
| <Parameters Name="DebugCWD"></Parameters> |
| <Parameters Name="Debug Symbols Search Path"></Parameters> |
| <Parameters Name="LoadAllSymbols">True</Parameters> |
| <Parameters Name="LoadUnspecifiedSymbols">False</Parameters> |
| </Parameters> |
| <Language> |
| <Language Name="ActiveLang"></Language> |
| <Language Name="ProjectLang">$00000000</Language> |
| <Language Name="RootDir"></Language> |
| </Language> |
| <VersionInfo> |
| <VersionInfo Name="IncludeVerInfo">False</VersionInfo> |
| <VersionInfo Name="AutoIncBuild">False</VersionInfo> |
| <VersionInfo Name="MajorVer">1</VersionInfo> |
| <VersionInfo Name="MinorVer">0</VersionInfo> |
| <VersionInfo Name="Release">0</VersionInfo> |
| <VersionInfo Name="Build">0</VersionInfo> |
| <VersionInfo Name="Debug">False</VersionInfo> |
| <VersionInfo Name="PreRelease">False</VersionInfo> |
| <VersionInfo Name="Special">False</VersionInfo> |
| <VersionInfo Name="Private">False</VersionInfo> |
| <VersionInfo Name="DLL">False</VersionInfo> |
| <VersionInfo Name="Locale">1031</VersionInfo> |
| <VersionInfo Name="CodePage">1252</VersionInfo> |
| </VersionInfo> |
| <VersionInfoKeys> |
| <VersionInfoKeys Name="CompanyName"></VersionInfoKeys> |
| <VersionInfoKeys Name="FileDescription"></VersionInfoKeys> |
| <VersionInfoKeys Name="FileVersion">1.0.0.0</VersionInfoKeys> |
| <VersionInfoKeys Name="InternalName"></VersionInfoKeys> |
| <VersionInfoKeys Name="LegalCopyright"></VersionInfoKeys> |
| <VersionInfoKeys Name="LegalTrademarks"></VersionInfoKeys> |
| <VersionInfoKeys Name="OriginalFilename"></VersionInfoKeys> |
| <VersionInfoKeys Name="ProductName"></VersionInfoKeys> |
| <VersionInfoKeys Name="ProductVersion">1.0.0.0</VersionInfoKeys> |
| <VersionInfoKeys Name="Comments"></VersionInfoKeys> |
| </VersionInfoKeys> |
| </Delphi.Personality> |
| </BorlandProject> |
| /FileMD5/md5.pas |
|---|
| 0,0 → 1,391 |
| // tabs = 2 |
| // ----------------------------------------------------------------------------------------------- |
| // |
| // MD5 Message-Digest for Delphi 4 |
| // |
| // Delphi 4 Unit implementing the |
| // RSA Data Security, Inc. MD5 Message-Digest Algorithm |
| // |
| // Implementation of Ronald L. Rivest's RFC 1321 |
| // |
| // Copyright © 1997-1999 Medienagentur Fichtner & Meyer |
| // Written by Matthias Fichtner |
| // |
| // ----------------------------------------------------------------------------------------------- |
| // See RFC 1321 for RSA Data Security's copyright and license notice! |
| // ----------------------------------------------------------------------------------------------- |
| // |
| // 14-Jun-97 mf Implemented MD5 according to RFC 1321 RFC 1321 |
| // 16-Jun-97 mf Initial release of the compiled unit (no source code) RFC 1321 |
| // 28-Feb-99 mf Added MD5Match function for comparing two digests RFC 1321 |
| // 13-Sep-99 mf Reworked the entire unit RFC 1321 |
| // 17-Sep-99 mf Reworked the "Test Driver" project RFC 1321 |
| // 19-Sep-99 mf Release of sources for MD5 unit and "Test Driver" project RFC 1321 |
| // |
| // ----------------------------------------------------------------------------------------------- |
| // The latest release of md5.pas will always be available from |
| // the distribution site at: http://www.fichtner.net/delphi/md5/ |
| // ----------------------------------------------------------------------------------------------- |
| // Please send questions, bug reports and suggestions |
| // regarding this code to: mfichtner@fichtner-meyer.com |
| // ----------------------------------------------------------------------------------------------- |
| // This code is provided "as is" without express or |
| // implied warranty of any kind. Use it at your own risk. |
| // ----------------------------------------------------------------------------------------------- |
| unit md5; |
| // ----------------------------------------------------------------------------------------------- |
| INTERFACE |
| // ----------------------------------------------------------------------------------------------- |
| uses |
| Windows; |
| type |
| MD5Count = array[0..1] of DWORD; |
| MD5State = array[0..3] of DWORD; |
| MD5Block = array[0..15] of DWORD; |
| MD5CBits = array[0..7] of byte; |
| MD5Digest = array[0..15] of byte; |
| MD5Buffer = array[0..63] of byte; |
| MD5Context = record |
| State: MD5State; |
| Count: MD5Count; |
| Buffer: MD5Buffer; |
| end; |
| procedure MD5Init(var Context: MD5Context); |
| procedure MD5Update(var Context: MD5Context; Input: pChar; Length: longword); |
| procedure MD5Final(var Context: MD5Context; var Digest: MD5Digest); |
| function MD5String(M: string): MD5Digest; |
| function MD5File(N: string): MD5Digest; |
| function MD5Print(D: MD5Digest): string; |
| function MD5Match(D1, D2: MD5Digest): boolean; |
| // ----------------------------------------------------------------------------------------------- |
| IMPLEMENTATION |
| // ----------------------------------------------------------------------------------------------- |
| var |
| PADDING: MD5Buffer = ( |
| $80, $00, $00, $00, $00, $00, $00, $00, |
| $00, $00, $00, $00, $00, $00, $00, $00, |
| $00, $00, $00, $00, $00, $00, $00, $00, |
| $00, $00, $00, $00, $00, $00, $00, $00, |
| $00, $00, $00, $00, $00, $00, $00, $00, |
| $00, $00, $00, $00, $00, $00, $00, $00, |
| $00, $00, $00, $00, $00, $00, $00, $00, |
| $00, $00, $00, $00, $00, $00, $00, $00 |
| ); |
| function F(x, y, z: DWORD): DWORD; |
| begin |
| Result := (x and y) or ((not x) and z); |
| end; |
| function G(x, y, z: DWORD): DWORD; |
| begin |
| Result := (x and z) or (y and (not z)); |
| end; |
| function H(x, y, z: DWORD): DWORD; |
| begin |
| Result := x xor y xor z; |
| end; |
| function I(x, y, z: DWORD): DWORD; |
| begin |
| Result := y xor (x or (not z)); |
| end; |
| procedure rot(var x: DWORD; n: BYTE); |
| begin |
| x := (x shl n) or (x shr (32 - n)); |
| end; |
| procedure FF(var a: DWORD; b, c, d, x: DWORD; s: BYTE; ac: DWORD); |
| begin |
| inc(a, F(b, c, d) + x + ac); |
| rot(a, s); |
| inc(a, b); |
| end; |
| procedure GG(var a: DWORD; b, c, d, x: DWORD; s: BYTE; ac: DWORD); |
| begin |
| inc(a, G(b, c, d) + x + ac); |
| rot(a, s); |
| inc(a, b); |
| end; |
| procedure HH(var a: DWORD; b, c, d, x: DWORD; s: BYTE; ac: DWORD); |
| begin |
| inc(a, H(b, c, d) + x + ac); |
| rot(a, s); |
| inc(a, b); |
| end; |
| procedure II(var a: DWORD; b, c, d, x: DWORD; s: BYTE; ac: DWORD); |
| begin |
| inc(a, I(b, c, d) + x + ac); |
| rot(a, s); |
| inc(a, b); |
| end; |
| // ----------------------------------------------------------------------------------------------- |
| // Encode Count bytes at Source into (Count / 4) DWORDs at Target |
| procedure Encode(Source, Target: pointer; Count: longword); |
| var |
| S: PByte; |
| T: PDWORD; |
| I: longword; |
| begin |
| S := Source; |
| T := Target; |
| for I := 1 to Count div 4 do begin |
| T^ := S^; |
| inc(S); |
| T^ := T^ or (S^ shl 8); |
| inc(S); |
| T^ := T^ or (S^ shl 16); |
| inc(S); |
| T^ := T^ or (S^ shl 24); |
| inc(S); |
| inc(T); |
| end; |
| end; |
| // Decode Count DWORDs at Source into (Count * 4) Bytes at Target |
| procedure Decode(Source, Target: pointer; Count: longword); |
| var |
| S: PDWORD; |
| T: PByte; |
| I: longword; |
| begin |
| S := Source; |
| T := Target; |
| for I := 1 to Count do begin |
| T^ := S^ and $ff; |
| inc(T); |
| T^ := (S^ shr 8) and $ff; |
| inc(T); |
| T^ := (S^ shr 16) and $ff; |
| inc(T); |
| T^ := (S^ shr 24) and $ff; |
| inc(T); |
| inc(S); |
| end; |
| end; |
| // Transform State according to first 64 bytes at Buffer |
| procedure Transform(Buffer: pointer; var State: MD5State); |
| var |
| a, b, c, d: DWORD; |
| Block: MD5Block; |
| begin |
| Encode(Buffer, @Block, 64); |
| a := State[0]; |
| b := State[1]; |
| c := State[2]; |
| d := State[3]; |
| FF (a, b, c, d, Block[ 0], 7, $d76aa478); |
| FF (d, a, b, c, Block[ 1], 12, $e8c7b756); |
| FF (c, d, a, b, Block[ 2], 17, $242070db); |
| FF (b, c, d, a, Block[ 3], 22, $c1bdceee); |
| FF (a, b, c, d, Block[ 4], 7, $f57c0faf); |
| FF (d, a, b, c, Block[ 5], 12, $4787c62a); |
| FF (c, d, a, b, Block[ 6], 17, $a8304613); |
| FF (b, c, d, a, Block[ 7], 22, $fd469501); |
| FF (a, b, c, d, Block[ 8], 7, $698098d8); |
| FF (d, a, b, c, Block[ 9], 12, $8b44f7af); |
| FF (c, d, a, b, Block[10], 17, $ffff5bb1); |
| FF (b, c, d, a, Block[11], 22, $895cd7be); |
| FF (a, b, c, d, Block[12], 7, $6b901122); |
| FF (d, a, b, c, Block[13], 12, $fd987193); |
| FF (c, d, a, b, Block[14], 17, $a679438e); |
| FF (b, c, d, a, Block[15], 22, $49b40821); |
| GG (a, b, c, d, Block[ 1], 5, $f61e2562); |
| GG (d, a, b, c, Block[ 6], 9, $c040b340); |
| GG (c, d, a, b, Block[11], 14, $265e5a51); |
| GG (b, c, d, a, Block[ 0], 20, $e9b6c7aa); |
| GG (a, b, c, d, Block[ 5], 5, $d62f105d); |
| GG (d, a, b, c, Block[10], 9, $2441453); |
| GG (c, d, a, b, Block[15], 14, $d8a1e681); |
| GG (b, c, d, a, Block[ 4], 20, $e7d3fbc8); |
| GG (a, b, c, d, Block[ 9], 5, $21e1cde6); |
| GG (d, a, b, c, Block[14], 9, $c33707d6); |
| GG (c, d, a, b, Block[ 3], 14, $f4d50d87); |
| GG (b, c, d, a, Block[ 8], 20, $455a14ed); |
| GG (a, b, c, d, Block[13], 5, $a9e3e905); |
| GG (d, a, b, c, Block[ 2], 9, $fcefa3f8); |
| GG (c, d, a, b, Block[ 7], 14, $676f02d9); |
| GG (b, c, d, a, Block[12], 20, $8d2a4c8a); |
| HH (a, b, c, d, Block[ 5], 4, $fffa3942); |
| HH (d, a, b, c, Block[ 8], 11, $8771f681); |
| HH (c, d, a, b, Block[11], 16, $6d9d6122); |
| HH (b, c, d, a, Block[14], 23, $fde5380c); |
| HH (a, b, c, d, Block[ 1], 4, $a4beea44); |
| HH (d, a, b, c, Block[ 4], 11, $4bdecfa9); |
| HH (c, d, a, b, Block[ 7], 16, $f6bb4b60); |
| HH (b, c, d, a, Block[10], 23, $bebfbc70); |
| HH (a, b, c, d, Block[13], 4, $289b7ec6); |
| HH (d, a, b, c, Block[ 0], 11, $eaa127fa); |
| HH (c, d, a, b, Block[ 3], 16, $d4ef3085); |
| HH (b, c, d, a, Block[ 6], 23, $4881d05); |
| HH (a, b, c, d, Block[ 9], 4, $d9d4d039); |
| HH (d, a, b, c, Block[12], 11, $e6db99e5); |
| HH (c, d, a, b, Block[15], 16, $1fa27cf8); |
| HH (b, c, d, a, Block[ 2], 23, $c4ac5665); |
| II (a, b, c, d, Block[ 0], 6, $f4292244); |
| II (d, a, b, c, Block[ 7], 10, $432aff97); |
| II (c, d, a, b, Block[14], 15, $ab9423a7); |
| II (b, c, d, a, Block[ 5], 21, $fc93a039); |
| II (a, b, c, d, Block[12], 6, $655b59c3); |
| II (d, a, b, c, Block[ 3], 10, $8f0ccc92); |
| II (c, d, a, b, Block[10], 15, $ffeff47d); |
| II (b, c, d, a, Block[ 1], 21, $85845dd1); |
| II (a, b, c, d, Block[ 8], 6, $6fa87e4f); |
| II (d, a, b, c, Block[15], 10, $fe2ce6e0); |
| II (c, d, a, b, Block[ 6], 15, $a3014314); |
| II (b, c, d, a, Block[13], 21, $4e0811a1); |
| II (a, b, c, d, Block[ 4], 6, $f7537e82); |
| II (d, a, b, c, Block[11], 10, $bd3af235); |
| II (c, d, a, b, Block[ 2], 15, $2ad7d2bb); |
| II (b, c, d, a, Block[ 9], 21, $eb86d391); |
| inc(State[0], a); |
| inc(State[1], b); |
| inc(State[2], c); |
| inc(State[3], d); |
| end; |
| // ----------------------------------------------------------------------------------------------- |
| // Initialize given Context |
| procedure MD5Init(var Context: MD5Context); |
| begin |
| with Context do begin |
| State[0] := $67452301; |
| State[1] := $efcdab89; |
| State[2] := $98badcfe; |
| State[3] := $10325476; |
| Count[0] := 0; |
| Count[1] := 0; |
| ZeroMemory(@Buffer, SizeOf(MD5Buffer)); |
| end; |
| end; |
| // Update given Context to include Length bytes of Input |
| procedure MD5Update(var Context: MD5Context; Input: pChar; Length: longword); |
| var |
| Index: longword; |
| PartLen: longword; |
| I: longword; |
| begin |
| with Context do begin |
| Index := (Count[0] shr 3) and $3f; |
| inc(Count[0], Length shl 3); |
| if Count[0] < (Length shl 3) then inc(Count[1]); |
| inc(Count[1], Length shr 29); |
| end; |
| PartLen := 64 - Index; |
| if Length >= PartLen then begin |
| CopyMemory(@Context.Buffer[Index], Input, PartLen); |
| Transform(@Context.Buffer, Context.State); |
| I := PartLen; |
| while I + 63 < Length do begin |
| Transform(@Input[I], Context.State); |
| inc(I, 64); |
| end; |
| Index := 0; |
| end else I := 0; |
| CopyMemory(@Context.Buffer[Index], @Input[I], Length - I); |
| end; |
| // Finalize given Context, create Digest and zeroize Context |
| procedure MD5Final(var Context: MD5Context; var Digest: MD5Digest); |
| var |
| Bits: MD5CBits; |
| Index: longword; |
| PadLen: longword; |
| begin |
| Decode(@Context.Count, @Bits, 2); |
| Index := (Context.Count[0] shr 3) and $3f; |
| if Index < 56 then PadLen := 56 - Index else PadLen := 120 - Index; |
| MD5Update(Context, @PADDING, PadLen); |
| MD5Update(Context, @Bits, 8); |
| Decode(@Context.State, @Digest, 4); |
| ZeroMemory(@Context, SizeOf(MD5Context)); |
| end; |
| // ----------------------------------------------------------------------------------------------- |
| // Create digest of given Message |
| function MD5String(M: string): MD5Digest; |
| var |
| Context: MD5Context; |
| begin |
| MD5Init(Context); |
| MD5Update(Context, pChar(M), length(M)); |
| MD5Final(Context, Result); |
| end; |
| // Create digest of file with given Name |
| function MD5File(N: string): MD5Digest; |
| var |
| FileHandle: THandle; |
| MapHandle: THandle; |
| ViewPointer: pointer; |
| Context: MD5Context; |
| begin |
| MD5Init(Context); |
| FileHandle := CreateFile(pChar(N), GENERIC_READ, FILE_SHARE_READ or FILE_SHARE_WRITE, |
| nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL or FILE_FLAG_SEQUENTIAL_SCAN, 0); |
| if FileHandle <> INVALID_HANDLE_VALUE then try |
| MapHandle := CreateFileMapping(FileHandle, nil, PAGE_READONLY, 0, 0, nil); |
| if MapHandle <> 0 then try |
| ViewPointer := MapViewOfFile(MapHandle, FILE_MAP_READ, 0, 0, 0); |
| if ViewPointer <> nil then try |
| MD5Update(Context, ViewPointer, GetFileSize(FileHandle, nil)); |
| finally |
| UnmapViewOfFile(ViewPointer); |
| end; |
| finally |
| CloseHandle(MapHandle); |
| end; |
| finally |
| CloseHandle(FileHandle); |
| end; |
| MD5Final(Context, Result); |
| end; |
| // Create hex representation of given Digest |
| function MD5Print(D: MD5Digest): string; |
| var |
| I: byte; |
| const |
| Digits: array[0..15] of char = |
| ('0', '1', '2', '3', '4', '5', '6', '7', '8', '9', 'a', 'b', 'c', 'd', 'e', 'f'); |
| begin |
| Result := ''; |
| for I := 0 to 15 do Result := Result + Digits[(D[I] shr 4) and $0f] + Digits[D[I] and $0f]; |
| end; |
| // ----------------------------------------------------------------------------------------------- |
| // Compare two Digests |
| function MD5Match(D1, D2: MD5Digest): boolean; |
| var |
| I: byte; |
| begin |
| I := 0; |
| Result := TRUE; |
| while Result and (I < 16) do begin |
| Result := D1[I] = D2[I]; |
| inc(I); |
| end; |
| end; |
| end. |
| /FileMD5/FileMD5.dpr |
|---|
| 0,0 → 1,17 |
| program FileMD5; |
| uses |
| Forms, |
| FileMD5Main in 'FileMD5Main.pas' {Form1}, |
| DropFiles in '..\_Common\DropFiles.pas' {Form2}, |
| md5 in 'md5.pas'; |
| {$R *.res} |
| begin |
| Application.Initialize; |
| Application.Title := 'Quick MD5 Calc'; |
| Application.CreateForm(TForm1, Form1); |
| Application.CreateForm(TForm2, Form2); |
| Application.Run; |
| end. |
| /FileMD5/FileMD5.dof |
|---|
| 0,0 → 1,87 |
| [FileVersion] |
| Version=6.0 |
| [Compiler] |
| A=8 |
| B=0 |
| C=1 |
| D=1 |
| E=0 |
| F=0 |
| G=1 |
| H=1 |
| I=1 |
| J=0 |
| K=0 |
| L=1 |
| M=0 |
| N=1 |
| O=1 |
| P=1 |
| Q=0 |
| R=0 |
| S=0 |
| T=0 |
| U=0 |
| V=1 |
| W=0 |
| X=1 |
| Y=1 |
| Z=1 |
| ShowHints=1 |
| ShowWarnings=1 |
| UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; |
| [Linker] |
| MapFile=0 |
| OutputObjs=0 |
| ConsoleApp=1 |
| DebugInfo=0 |
| RemoteSymbols=0 |
| MinStackSize=16384 |
| MaxStackSize=1048576 |
| ImageBase=4194304 |
| ExeDescription= |
| [Directories] |
| OutputDir= |
| UnitOutputDir= |
| PackageDLLOutputDir= |
| PackageDCPOutputDir= |
| SearchPath= |
| Packages= |
| Conditionals= |
| DebugSourceDirs= |
| UsePackages=0 |
| [Parameters] |
| RunParams= |
| HostApplication= |
| Launcher= |
| UseLauncher=0 |
| DebugCWD= |
| [Language] |
| ActiveLang= |
| ProjectLang= |
| RootDir= |
| [Version Info] |
| IncludeVerInfo=0 |
| AutoIncBuild=0 |
| MajorVer=1 |
| MinorVer=0 |
| Release=0 |
| Build=0 |
| Debug=0 |
| PreRelease=0 |
| Special=0 |
| Private=0 |
| DLL=0 |
| Locale=1031 |
| CodePage=1252 |
| [Version Info Keys] |
| CompanyName= |
| FileDescription= |
| FileVersion=1.0.0.0 |
| InternalName= |
| LegalCopyright= |
| LegalTrademarks= |
| OriginalFilename= |
| ProductName= |
| ProductVersion=1.0.0.0 |
| Comments= |
| /FileMD5/FileMD5Main.pas |
|---|
| 0,0 → 1,124 |
| unit FileMD5Main; |
| interface |
| uses |
| Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, |
| Dialogs, StdCtrls, ShellAPI; |
| type |
| TForm1 = class(TForm) |
| Edit1: TEdit; |
| Edit2: TEdit; |
| Label1: TLabel; |
| Label2: TLabel; |
| procedure FormShow(Sender: TObject); |
| private |
| choosenfile: string; |
| protected |
| procedure ChooseFile(f: string); |
| procedure CalcMD5(); |
| end; |
| var |
| Form1: TForm1; |
| implementation |
| {$R *.dfm} |
| uses |
| MD5, DropFiles; |
| resourcestring |
| lng_file_not_found = 'The file "%s" was not found!'; |
| lng_is_a_dir = 'MD5 checksum can only calculated for files.'; |
| function MyFileSize(fn: string): int64; |
| var |
| fs: TFileStream; |
| begin |
| fs := TFileStream.Create(fn, fmOpenRead or fmShareDenyWrite); |
| try |
| result := fs.Size; |
| finally |
| fs.Free; |
| end; |
| end; |
| procedure TForm1.CalcMD5(); |
| const |
| ZERO_HASH = 'd41d8cd98f00b204e9800998ecf8427e'; |
| resourcestring |
| lng_fatal_error = 'Fatal error!'; |
| var |
| h: string; |
| begin |
| h := MD5Print(MD5File(choosenfile)); |
| // Additional check |
| if (MyFileSize(choosenfile) <> 0) and (h = ZERO_HASH) then |
| begin |
| ShowMessage(lng_fatal_error); |
| Exit; |
| end; |
| Edit1.Text := h; |
| end; |
| procedure TForm1.ChooseFile(f: string); |
| begin |
| choosenfile := f; |
| Label1.Caption := ExtractFileName(f); |
| Edit2.Text := f; |
| end; |
| procedure TForm1.FormShow(Sender: TObject); |
| var |
| f, nf: string; |
| i: Integer; |
| resourcestring |
| lng_syntax = 'Syntax: %s filename'; |
| begin |
| if ParamCount() < 1 then |
| begin |
| // ShowMessageFmt(lng_syntax, [ExtractFileName(Application.ExeName)]); |
| Form2.SetMsg(Format(lng_syntax, [ExtractFileName(Application.ExeName)])); |
| Form2.SetCap(Caption); |
| Form2.ShowModal; |
| Close; |
| Exit; |
| end; |
| f := ParamStr(1); |
| if DirectoryExists(f) then |
| begin |
| ShowMessage(lng_is_a_dir); |
| Close; |
| Exit; |
| end; |
| if not FileExists(f) then |
| begin |
| ShowMessageFmt(lng_file_not_found, [f]); |
| Close; |
| Exit; |
| end; |
| if ParamCount() > 1 then |
| begin |
| for i := 2 to ParamCount() do |
| begin |
| nf := ParamStr(i); |
| ShellExecute(Handle, 'open', PChar('"'+Application.ExeName+'"'), |
| PChar('"'+nf+'"'), PChar('"'+ExtractFilePath(Application.ExeName)+'"'), SW_NORMAL); |
| end; |
| end; |
| ChooseFile(f); |
| CalcMD5(); |
| end; |
| end. |
| /FileMD5/FileMD5.res |
|---|
| Cannot display: file marked as a binary type. |
| svn:mime-type = application/octet-stream |
| Property changes: |
| Added: svn:mime-type |
| +application/octet-stream |
| \ No newline at end of property |
| /_Common/DropFiles.dcu |
|---|
| Cannot display: file marked as a binary type. |
| svn:mime-type = application/octet-stream |
| Property changes: |
| Added: svn:mime-type |
| +application/octet-stream |
| \ No newline at end of property |
| /_Common/DropFiles.pas |
|---|
| 0,0 → 1,90 |
| unit DropFiles; |
| interface |
| uses |
| Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, |
| Dialogs, StdCtrls; |
| type |
| TForm2 = class(TForm) |
| Memo1: TMemo; |
| procedure FormCreate(Sender: TObject); |
| private |
| procedure HandleDroppedFile(acFileName: string); |
| public |
| procedure DropFiles( var msg : TMessage ); |
| message WM_DROPFILES; |
| procedure SetMsg(s: string); |
| procedure SetCap(s: string); |
| end; |
| var |
| Form2: TForm2; |
| implementation |
| {$R *.dfm} |
| uses |
| ShellAPI; |
| procedure TForm2.HandleDroppedFile(acFileName: string); |
| begin |
| // Showmessage(acFileName); |
| ShellExecute(Handle, 'open', PChar('"'+Application.ExeName+'"'), PChar('"'+acFileName+'"'), PChar('"'+ExtractFilePath(Application.ExeName)+'"'), SW_NORMAL); |
| // Das ist Ansichtssache |
| // Close; |
| end; |
| // Ref: http://www.chami.com/tips/delphi/111196D.html |
| (* |
| public |
| procedure DropFiles( var msg : TMessage ); |
| message WM_DROPFILES; |
| *) |
| procedure TForm2.DropFiles( var msg : TMessage ); |
| const |
| cnMaxFileNameLen = 255; |
| var |
| i, |
| nCount : integer; |
| acFileName : array [0..cnMaxFileNameLen] of char; |
| begin |
| nCount := DragQueryFile( msg.WParam, |
| $FFFFFFFF, |
| acFileName, |
| cnMaxFileNameLen ); |
| for i := 0 to nCount-1 do |
| begin |
| DragQueryFile( msg.WParam, i, |
| acFileName, cnMaxFileNameLen ); |
| HandleDroppedFile(acFileName); |
| end; |
| DragFinish( msg.WParam ); |
| end; |
| procedure TForm2.FormCreate(Sender: TObject); |
| begin |
| DragAcceptFiles( Handle, True ); |
| end; |
| procedure TForm2.SetMsg(s: string); |
| begin |
| Memo1.Text := s; |
| end; |
| procedure TForm2.SetCap(s: string); |
| begin |
| Caption := s + ' - ' + Caption; |
| end; |
| end. |
| /_Common/DropFiles.dfm |
|---|
| 0,0 → 1,30 |
| object Form2: TForm2 |
| Left = 0 |
| Top = 0 |
| BorderIcons = [biSystemMenu, biMinimize] |
| BorderStyle = bsSingle |
| Caption = 'Drop Files Here' |
| ClientHeight = 157 |
| ClientWidth = 341 |
| Color = clBtnFace |
| Font.Charset = DEFAULT_CHARSET |
| Font.Color = clWindowText |
| Font.Height = -11 |
| Font.Name = 'Tahoma' |
| Font.Style = [] |
| OldCreateOrder = False |
| Position = poScreenCenter |
| OnCreate = FormCreate |
| PixelsPerInch = 96 |
| TextHeight = 13 |
| object Memo1: TMemo |
| Left = 0 |
| Top = 0 |
| Width = 341 |
| Height = 157 |
| Align = alClient |
| Color = clBtnFace |
| ReadOnly = True |
| TabOrder = 0 |
| end |
| end |
| /clean.bat |
|---|
| 0,0 → 1,69 |
| @echo off |
| rd /s /q __history |
| del *.identcache |
| del *.~* |
| del *.local |
| cd "_Common" |
| rd /s /q __history |
| del *.identcache |
| del *.~* |
| del *.local |
| cd .. |
| cd "Create Shortcut" |
| rd /s /q __history |
| del *.identcache |
| del *.~* |
| del *.local |
| cd .. |
| cd "DosLineConv" |
| rd /s /q __history |
| del *.identcache |
| del *.~* |
| del *.local |
| cd .. |
| cd "FileExtCh" |
| rd /s /q __history |
| del *.identcache |
| del *.~* |
| del *.local |
| cd .. |
| cd "FileMD5" |
| rd /s /q __history |
| del *.identcache |
| del *.~* |
| del *.local |
| cd .. |
| cd "Kalenderersatz" |
| rd /s /q __history |
| del *.identcache |
| del *.~* |
| del *.local |
| cd .. |
| cd "Uhrersatz (Atomuhr)" |
| rd /s /q __history |
| del *.identcache |
| del *.~* |
| del *.local |
| cd .. |
| cd "CmdHere" |
| rd /s /q __history |
| del *.identcache |
| del *.~* |
| del *.local |
| cd .. |
| cd "DNDFC (Drag'n'Drop FileCompare)" |
| rd /s /q __history |
| del *.identcache |
| del *.~* |
| del *.local |
| cd .. |
| /FileExtCh/FileExtCh.dpr |
|---|
| 0,0 → 1,16 |
| program FileExtCh; |
| uses |
| Forms, |
| FileExtChMain in 'FileExtChMain.pas' {Form1}, |
| DropFiles in '..\_Common\DropFiles.pas' {Form2}; |
| {$R *.res} |
| begin |
| Application.Initialize; |
| Application.Title := 'Change FileExt'; |
| Application.CreateForm(TForm1, Form1); |
| Application.CreateForm(TForm2, Form2); |
| Application.Run; |
| end. |
| /FileExtCh/FileExtCh.dof |
|---|
| 0,0 → 1,87 |
| [FileVersion] |
| Version=6.0 |
| [Compiler] |
| A=8 |
| B=0 |
| C=1 |
| D=1 |
| E=0 |
| F=0 |
| G=1 |
| H=1 |
| I=1 |
| J=0 |
| K=0 |
| L=1 |
| M=0 |
| N=1 |
| O=1 |
| P=1 |
| Q=0 |
| R=0 |
| S=0 |
| T=0 |
| U=0 |
| V=1 |
| W=0 |
| X=1 |
| Y=1 |
| Z=1 |
| ShowHints=1 |
| ShowWarnings=1 |
| UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; |
| [Linker] |
| MapFile=0 |
| OutputObjs=0 |
| ConsoleApp=1 |
| DebugInfo=0 |
| RemoteSymbols=0 |
| MinStackSize=16384 |
| MaxStackSize=1048576 |
| ImageBase=4194304 |
| ExeDescription= |
| [Directories] |
| OutputDir= |
| UnitOutputDir= |
| PackageDLLOutputDir= |
| PackageDCPOutputDir= |
| SearchPath= |
| Packages= |
| Conditionals= |
| DebugSourceDirs= |
| UsePackages=0 |
| [Parameters] |
| RunParams= |
| HostApplication= |
| Launcher= |
| UseLauncher=0 |
| DebugCWD= |
| [Language] |
| ActiveLang= |
| ProjectLang= |
| RootDir= |
| [Version Info] |
| IncludeVerInfo=0 |
| AutoIncBuild=0 |
| MajorVer=1 |
| MinorVer=0 |
| Release=0 |
| Build=0 |
| Debug=0 |
| PreRelease=0 |
| Special=0 |
| Private=0 |
| DLL=0 |
| Locale=1031 |
| CodePage=1252 |
| [Version Info Keys] |
| CompanyName= |
| FileDescription= |
| FileVersion=1.0.0.0 |
| InternalName= |
| LegalCopyright= |
| LegalTrademarks= |
| OriginalFilename= |
| ProductName= |
| ProductVersion=1.0.0.0 |
| Comments= |
| /FileExtCh/FileExtChMain.pas |
|---|
| 0,0 → 1,136 |
| unit FileExtChMain; |
| interface |
| uses |
| Windows, Dialogs, SysUtils, Forms, Classes, Controls, StdCtrls; |
| type |
| TForm1 = class(TForm) |
| Edit1: TEdit; |
| Label1: TLabel; |
| Button1: TButton; |
| Button2: TButton; |
| procedure FormShow(Sender: TObject); |
| procedure Button2Click(Sender: TObject); |
| procedure Button1Click(Sender: TObject); |
| private |
| f, e: string; |
| protected |
| function GetChoosenExt: string; |
| end; |
| var |
| Form1: TForm1; |
| implementation |
| uses |
| DropFiles, ShellAPI; |
| {$R *.dfm} |
| resourcestring |
| lng_file_not_found = 'The file "%s" was not found!'; |
| lng_is_a_dir = 'A directory has no filename extension which could be changed.'; |
| function RemoveFileNameExt(fn: string): string; |
| begin |
| result := Copy(fn, 1, Length(fn)-Length(ExtractFileExt(fn))); |
| end; |
| procedure TForm1.FormShow(Sender: TObject); |
| resourcestring |
| lng_syntax = 'Syntax: %s filename'; |
| var |
| i: integer; |
| nf: string; |
| begin |
| if ParamCount() < 1 then |
| begin |
| // ShowMessageFmt(lng_syntax, [ExtractFileName(Application.ExeName)]); |
| Form2.SetMsg(Format(lng_syntax, [ExtractFileName(Application.ExeName)])); |
| Form2.SetCap(Caption); |
| Form2.ShowModal; |
| Close; |
| Exit; |
| end; |
| f := ParamStr(1); |
| e := ExtractFileExt(f); |
| if DirectoryExists(f) then |
| begin |
| ShowMessage(lng_is_a_dir); |
| Close; |
| Exit; |
| end; |
| if not FileExists(f) then |
| begin |
| ShowMessageFmt(lng_file_not_found, [f]); |
| Close; |
| Exit; |
| end; |
| if ParamCount() > 1 then |
| begin |
| for i := 2 to ParamCount() do |
| begin |
| nf := ParamStr(i); |
| ShellExecute(Handle, 'open', PChar('"'+Application.ExeName+'"'), |
| PChar('"'+nf+'"'), PChar('"'+ExtractFilePath(Application.ExeName)+'"'), SW_NORMAL); |
| end; |
| end; |
| Label1.Caption := ExtractFileName(f); |
| Edit1.Text := Copy(e, 2, Length(e)-1); |
| Edit1.SetFocus; |
| end; |
| procedure TForm1.Button2Click(Sender: TObject); |
| begin |
| Close; |
| end; |
| procedure TForm1.Button1Click(Sender: TObject); |
| var |
| n: string; |
| resourcestring |
| lng_move_error = 'Could not move file "%s" to "%s". Error code: %d.'; |
| lng_target_already_exists = 'The target file "%s" already exists. Rename not possible.'; |
| begin |
| n := RemoveFileNameExt(f)+GetChoosenExt; |
| if not FileExists(f) then |
| begin |
| ShowMessageFmt(lng_file_not_found, [f]); |
| Close; |
| Exit; |
| end; |
| if FileExists(n) then |
| begin |
| ShowMessageFmt(lng_target_already_exists, [n]); |
| Close; |
| Exit; |
| end; |
| if not MoveFile(PChar(f), PChar(n)) then |
| begin |
| ShowMessageFmt(lng_move_error, [f, n, GetLastError()]); |
| end; |
| Close; |
| end; |
| function TForm1.GetChoosenExt: string; |
| begin |
| if Edit1.Text = '' then |
| result := '' |
| else |
| result := '.'+Edit1.text; |
| end; |
| end. |
| /FileExtCh/FileExtCh.res |
|---|
| Cannot display: file marked as a binary type. |
| svn:mime-type = application/octet-stream |
| Property changes: |
| Added: svn:mime-type |
| +application/octet-stream |
| \ No newline at end of property |
| /FileExtCh/FileExtChMain.dfm |
|---|
| 0,0 → 1,54 |
| object Form1: TForm1 |
| Left = 192 |
| Top = 113 |
| BorderIcons = [biSystemMenu, biMinimize] |
| BorderStyle = bsSingle |
| Caption = 'Change FileExt' |
| ClientHeight = 97 |
| ClientWidth = 225 |
| Color = clBtnFace |
| Font.Charset = DEFAULT_CHARSET |
| Font.Color = clWindowText |
| Font.Height = -11 |
| Font.Name = 'MS Sans Serif' |
| Font.Style = [] |
| OldCreateOrder = False |
| Position = poScreenCenter |
| OnShow = FormShow |
| PixelsPerInch = 96 |
| TextHeight = 13 |
| object Label1: TLabel |
| Left = 8 |
| Top = 8 |
| Width = 32 |
| Height = 13 |
| Caption = 'Label1' |
| end |
| object Edit1: TEdit |
| Left = 8 |
| Top = 32 |
| Width = 209 |
| Height = 21 |
| TabOrder = 0 |
| end |
| object Button1: TButton |
| Left = 120 |
| Top = 64 |
| Width = 99 |
| Height = 25 |
| Caption = 'OK' |
| Default = True |
| TabOrder = 1 |
| OnClick = Button1Click |
| end |
| object Button2: TButton |
| Left = 8 |
| Top = 64 |
| Width = 97 |
| Height = 25 |
| Cancel = True |
| Caption = 'Cancel' |
| TabOrder = 2 |
| OnClick = Button2Click |
| end |
| end |
| /FileExtCh/FileExtCh.cfg |
|---|
| 0,0 → 1,42 |
| -$A8 |
| -$B- |
| -$C+ |
| -$D+ |
| -$E- |
| -$F- |
| -$G+ |
| -$H+ |
| -$I+ |
| -$J- |
| -$K- |
| -$L+ |
| -$M- |
| -$N+ |
| -$O+ |
| -$P+ |
| -$Q- |
| -$R- |
| -$S- |
| -$T- |
| -$U- |
| -$V+ |
| -$W- |
| -$X+ |
| -$YD |
| -$Z1 |
| -cg |
| -AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; |
| -H+ |
| -W+ |
| -M |
| -$M16384,1048576 |
| -K$00400000 |
| -LE"C:\Dokumente und Einstellungen\Daniel Marschall\Eigene Dateien\Borland Studio-Projekte\Bpl" |
| -LN"C:\Dokumente und Einstellungen\Daniel Marschall\Eigene Dateien\Borland Studio-Projekte\Bpl" |
| -U"../_Common" |
| -O"../_Common" |
| -I"../_Common" |
| -R"../_Common" |
| -w-UNSAFE_TYPE |
| -w-UNSAFE_CODE |
| -w-UNSAFE_CAST |
| /FileExtCh/FileExtChMain.dcu |
|---|
| Cannot display: file marked as a binary type. |
| svn:mime-type = application/octet-stream |
| Property changes: |
| Added: svn:mime-type |
| +application/octet-stream |
| \ No newline at end of property |
| /FileExtCh/FileExtCh.exe |
|---|
| Cannot display: file marked as a binary type. |
| svn:mime-type = application/octet-stream |
| Property changes: |
| Added: svn:mime-type |
| +application/octet-stream |
| \ No newline at end of property |
| /FileExtCh/FileExtCh.bdsproj |
|---|
| 0,0 → 1,175 |
| <?xml version="1.0" encoding="utf-8"?> |
| <BorlandProject> |
| <PersonalityInfo> |
| <Option> |
| <Option Name="Personality">Delphi.Personality</Option> |
| <Option Name="ProjectType">VCLApplication</Option> |
| <Option Name="Version">1.0</Option> |
| <Option Name="GUID">{BA2ECA5E-FCC2-4EDB-B98E-6EE1558C4F1C}</Option> |
| </Option> |
| </PersonalityInfo> |
| <Delphi.Personality> |
| <Source> |
| <Source Name="MainSource">FileExtCh.dpr</Source> |
| </Source> |
| <FileVersion> |
| <FileVersion Name="Version">7.0</FileVersion> |
| </FileVersion> |
| <Compiler> |
| <Compiler Name="A">8</Compiler> |
| <Compiler Name="B">0</Compiler> |
| <Compiler Name="C">1</Compiler> |
| <Compiler Name="D">1</Compiler> |
| <Compiler Name="E">0</Compiler> |
| <Compiler Name="F">0</Compiler> |
| <Compiler Name="G">1</Compiler> |
| <Compiler Name="H">1</Compiler> |
| <Compiler Name="I">1</Compiler> |
| <Compiler Name="J">0</Compiler> |
| <Compiler Name="K">0</Compiler> |
| <Compiler Name="L">1</Compiler> |
| <Compiler Name="M">0</Compiler> |
| <Compiler Name="N">1</Compiler> |
| <Compiler Name="O">1</Compiler> |
| <Compiler Name="P">1</Compiler> |
| <Compiler Name="Q">0</Compiler> |
| <Compiler Name="R">0</Compiler> |
| <Compiler Name="S">0</Compiler> |
| <Compiler Name="T">0</Compiler> |
| <Compiler Name="U">0</Compiler> |
| <Compiler Name="V">1</Compiler> |
| <Compiler Name="W">0</Compiler> |
| <Compiler Name="X">1</Compiler> |
| <Compiler Name="Y">1</Compiler> |
| <Compiler Name="Z">1</Compiler> |
| <Compiler Name="ShowHints">True</Compiler> |
| <Compiler Name="ShowWarnings">True</Compiler> |
| <Compiler Name="UnitAliases">WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;</Compiler> |
| <Compiler Name="NamespacePrefix"></Compiler> |
| <Compiler Name="GenerateDocumentation">False</Compiler> |
| <Compiler Name="DefaultNamespace"></Compiler> |
| <Compiler Name="SymbolDeprecated">True</Compiler> |
| <Compiler Name="SymbolLibrary">True</Compiler> |
| <Compiler Name="SymbolPlatform">True</Compiler> |
| <Compiler Name="SymbolExperimental">True</Compiler> |
| <Compiler Name="UnitLibrary">True</Compiler> |
| <Compiler Name="UnitPlatform">True</Compiler> |
| <Compiler Name="UnitDeprecated">True</Compiler> |
| <Compiler Name="UnitExperimental">True</Compiler> |
| <Compiler Name="HResultCompat">True</Compiler> |
| <Compiler Name="HidingMember">True</Compiler> |
| <Compiler Name="HiddenVirtual">True</Compiler> |
| <Compiler Name="Garbage">True</Compiler> |
| <Compiler Name="BoundsError">True</Compiler> |
| <Compiler Name="ZeroNilCompat">True</Compiler> |
| <Compiler Name="StringConstTruncated">True</Compiler> |
| <Compiler Name="ForLoopVarVarPar">True</Compiler> |
| <Compiler Name="TypedConstVarPar">True</Compiler> |
| <Compiler Name="AsgToTypedConst">True</Compiler> |
| <Compiler Name="CaseLabelRange">True</Compiler> |
| <Compiler Name="ForVariable">True</Compiler> |
| <Compiler Name="ConstructingAbstract">True</Compiler> |
| <Compiler Name="ComparisonFalse">True</Compiler> |
| <Compiler Name="ComparisonTrue">True</Compiler> |
| <Compiler Name="ComparingSignedUnsigned">True</Compiler> |
| <Compiler Name="CombiningSignedUnsigned">True</Compiler> |
| <Compiler Name="UnsupportedConstruct">True</Compiler> |
| <Compiler Name="FileOpen">True</Compiler> |
| <Compiler Name="FileOpenUnitSrc">True</Compiler> |
| <Compiler Name="BadGlobalSymbol">True</Compiler> |
| <Compiler Name="DuplicateConstructorDestructor">True</Compiler> |
| <Compiler Name="InvalidDirective">True</Compiler> |
| <Compiler Name="PackageNoLink">True</Compiler> |
| <Compiler Name="PackageThreadVar">True</Compiler> |
| <Compiler Name="ImplicitImport">True</Compiler> |
| <Compiler Name="HPPEMITIgnored">True</Compiler> |
| <Compiler Name="NoRetVal">True</Compiler> |
| <Compiler Name="UseBeforeDef">True</Compiler> |
| <Compiler Name="ForLoopVarUndef">True</Compiler> |
| <Compiler Name="UnitNameMismatch">True</Compiler> |
| <Compiler Name="NoCFGFileFound">True</Compiler> |
| <Compiler Name="ImplicitVariants">True</Compiler> |
| <Compiler Name="UnicodeToLocale">True</Compiler> |
| <Compiler Name="LocaleToUnicode">True</Compiler> |
| <Compiler Name="ImagebaseMultiple">True</Compiler> |
| <Compiler Name="SuspiciousTypecast">True</Compiler> |
| <Compiler Name="PrivatePropAccessor">True</Compiler> |
| <Compiler Name="UnsafeType">False</Compiler> |
| <Compiler Name="UnsafeCode">False</Compiler> |
| <Compiler Name="UnsafeCast">False</Compiler> |
| <Compiler Name="OptionTruncated">True</Compiler> |
| <Compiler Name="WideCharReduced">True</Compiler> |
| <Compiler Name="DuplicatesIgnored">True</Compiler> |
| <Compiler Name="UnitInitSeq">True</Compiler> |
| <Compiler Name="LocalPInvoke">True</Compiler> |
| <Compiler Name="MessageDirective">True</Compiler> |
| <Compiler Name="CodePage"></Compiler> |
| </Compiler> |
| <Linker> |
| <Linker Name="MapFile">0</Linker> |
| <Linker Name="OutputObjs">0</Linker> |
| <Linker Name="GenerateHpps">False</Linker> |
| <Linker Name="ConsoleApp">1</Linker> |
| <Linker Name="DebugInfo">False</Linker> |
| <Linker Name="RemoteSymbols">False</Linker> |
| <Linker Name="GenerateDRC">False</Linker> |
| <Linker Name="MinStackSize">16384</Linker> |
| <Linker Name="MaxStackSize">1048576</Linker> |
| <Linker Name="ImageBase">4194304</Linker> |
| <Linker Name="ExeDescription"></Linker> |
| </Linker> |
| <Directories> |
| <Directories Name="OutputDir"></Directories> |
| <Directories Name="UnitOutputDir"></Directories> |
| <Directories Name="PackageDLLOutputDir"></Directories> |
| <Directories Name="PackageDCPOutputDir"></Directories> |
| <Directories Name="SearchPath">../_Common</Directories> |
| <Directories Name="Packages"></Directories> |
| <Directories Name="Conditionals"></Directories> |
| <Directories Name="DebugSourceDirs"></Directories> |
| <Directories Name="UsePackages">False</Directories> |
| </Directories> |
| <Parameters> |
| <Parameters Name="RunParams"></Parameters> |
| <Parameters Name="HostApplication"></Parameters> |
| <Parameters Name="Launcher"></Parameters> |
| <Parameters Name="UseLauncher">False</Parameters> |
| <Parameters Name="DebugCWD"></Parameters> |
| <Parameters Name="Debug Symbols Search Path"></Parameters> |
| <Parameters Name="LoadAllSymbols">True</Parameters> |
| <Parameters Name="LoadUnspecifiedSymbols">False</Parameters> |
| </Parameters> |
| <Language> |
| <Language Name="ActiveLang"></Language> |
| <Language Name="ProjectLang">$00000000</Language> |
| <Language Name="RootDir"></Language> |
| </Language> |
| <VersionInfo> |
| <VersionInfo Name="IncludeVerInfo">False</VersionInfo> |
| <VersionInfo Name="AutoIncBuild">False</VersionInfo> |
| <VersionInfo Name="MajorVer">1</VersionInfo> |
| <VersionInfo Name="MinorVer">0</VersionInfo> |
| <VersionInfo Name="Release">0</VersionInfo> |
| <VersionInfo Name="Build">0</VersionInfo> |
| <VersionInfo Name="Debug">False</VersionInfo> |
| <VersionInfo Name="PreRelease">False</VersionInfo> |
| <VersionInfo Name="Special">False</VersionInfo> |
| <VersionInfo Name="Private">False</VersionInfo> |
| <VersionInfo Name="DLL">False</VersionInfo> |
| <VersionInfo Name="Locale">1031</VersionInfo> |
| <VersionInfo Name="CodePage">1252</VersionInfo> |
| </VersionInfo> |
| <VersionInfoKeys> |
| <VersionInfoKeys Name="CompanyName"></VersionInfoKeys> |
| <VersionInfoKeys Name="FileDescription"></VersionInfoKeys> |
| <VersionInfoKeys Name="FileVersion">1.0.0.0</VersionInfoKeys> |
| <VersionInfoKeys Name="InternalName"></VersionInfoKeys> |
| <VersionInfoKeys Name="LegalCopyright"></VersionInfoKeys> |
| <VersionInfoKeys Name="LegalTrademarks"></VersionInfoKeys> |
| <VersionInfoKeys Name="OriginalFilename"></VersionInfoKeys> |
| <VersionInfoKeys Name="ProductName"></VersionInfoKeys> |
| <VersionInfoKeys Name="ProductVersion">1.0.0.0</VersionInfoKeys> |
| <VersionInfoKeys Name="Comments"></VersionInfoKeys> |
| </VersionInfoKeys> |
| </Delphi.Personality> |
| </BorlandProject> |
| /Kalenderersatz/FullYearCalendar.pas |
|---|
| 0,0 → 1,157 |
| unit FullYearCalendar; |
| interface |
| uses |
| Windows, Messages, SysUtils, Classes, Controls, ComCtrls; |
| // TODO: Buggy if you select a month directly (click at the month name) |
| // -- since the months are fixed, this functionality should be disabled by Windows! |
| // TODO: Multiselect führt zu einem Fehler ... |
| // -- Grund: Das springen zum Jahresende und Jahresanfang |
| // -- Also: Only 30 days selectable |
| // TODO: Die wahre Größe für 12 Monate feststellen ... wie? |
| // TODO: MaxSelectRange sollte 365 oder 366 sein... |
| type |
| TFullYearCalendar = class(TMonthCalendar) |
| private |
| function GetDate: TDate; |
| procedure SetDate(Value: TDate); |
| function GetDateTime: TDateTime; |
| procedure SetDateTime(Value: TDateTime); |
| procedure CNNotify(var Message: TWMNotify); message CN_NOTIFY; |
| public |
| constructor Create(AOwner: TComponent); override; |
| protected |
| property DateTime: TDateTime read GetDateTime write SetDateTime; |
| published |
| property Date: TDate read GetDate write SetDate; |
| end; |
| procedure Register; |
| implementation |
| uses |
| DateUtils, CommCtrl; |
| function TFullYearCalendar.GetDate: TDate; |
| begin |
| result := inherited Date; |
| end; |
| procedure TFullYearCalendar.SetDate(Value: TDate); |
| begin |
| if YearOf(Value) <> YearOf(Date) then |
| begin |
| // User has scrolled. |
| // The problem is, that the scrolling does not use Date as the source, |
| // instead it takes the left top month as source. So, every scrolling |
| // would set the month to January! |
| if MonthOf(DateTime) <> 1 then |
| begin |
| Value := IncMonth(Value, MonthOf(DateTime)-1); |
| end; |
| end; |
| // We want to have January always on left top! |
| // Warning: Does not work if the control is too small. |
| if not MultiSelect then |
| begin |
| inherited Date := EndOfTheYear(Value); |
| inherited Date := StartOfTheYear(Value); |
| end; |
| // Then jump to our desired date |
| inherited Date := Value; |
| end; |
| function TFullYearCalendar.GetDateTime: TDateTime; |
| begin |
| result := Date; |
| end; |
| procedure TFullYearCalendar.SetDateTime(Value: TDateTime); |
| begin |
| Date := Value; |
| end; |
| constructor TFullYearCalendar.Create(AOwner: TComponent); |
| begin |
| inherited Create(AOwner); |
| // Checked with Windows 2000 |
| // Warning: Does not work if you use larger fonts! |
| // TODO: Is there any way to determinate the real width and height of a full year? |
| // Width := 666; |
| // Height := 579; |
| Width := 724; |
| Height := 500; |
| Constraints.MinWidth := Width; |
| Constraints.MinHeight := Height; |
| // Only jump in years |
| MonthDelta := 12; |
| end; |
| procedure Register; |
| begin |
| RegisterComponents('Beispiele', [TFullYearCalendar]); |
| end; |
| // Copied from ComCtrls.pas |
| function IsBlankSysTime(const ST: TSystemTime): Boolean; |
| type |
| TFast = array [0..3] of DWORD; |
| begin |
| Result := (TFast(ST)[0] or TFast(ST)[1] or TFast(ST)[2] or TFast(ST)[3]) = 0; |
| end; |
| // Copied from ComCtrls.pas - modified |
| // This is necessary, so that our "Date" will be changed when the user scrolls! |
| procedure TFullYearCalendar.CNNotify(var Message: TWMNotify); |
| var |
| ST: PSystemTime; |
| //I, MonthNo: Integer; |
| //CurState: PMonthDayState; |
| begin |
| with Message, NMHdr^ do |
| begin |
| case code of |
| (* MCN_GETDAYSTATE: |
| with PNmDayState(NMHdr)^ do |
| begin |
| FillChar(prgDayState^, cDayState * SizeOf(TMonthDayState), 0); |
| if Assigned(FOnGetMonthInfo) then |
| begin |
| CurState := prgDayState; |
| for I := 0 to cDayState - 1 do |
| begin |
| MonthNo := stStart.wMonth + I; |
| if MonthNo > 12 then MonthNo := MonthNo - 12; |
| FOnGetMonthInfo(Self, MonthNo, CurState^); |
| Inc(CurState); |
| end; |
| end; |
| end; *) |
| MCN_SELECT, MCN_SELCHANGE: |
| begin |
| ST := @PNMSelChange(NMHdr).stSelStart; |
| if not IsBlankSysTime(ST^) then |
| (*F*)DateTime := SystemTimeToDateTime(ST^); |
| if (*F*)MultiSelect then |
| begin |
| ST := @PNMSelChange(NMHdr).stSelEnd; |
| if not IsBlankSysTime(ST^) then |
| (*F*)EndDate := SystemTimeToDateTime(ST^); |
| end; |
| end; |
| end; |
| end; |
| inherited; |
| end; |
| end. |
| /Kalenderersatz/Calender.bdsproj |
|---|
| 0,0 → 1,175 |
| <?xml version="1.0" encoding="utf-8"?> |
| <BorlandProject> |
| <PersonalityInfo> |
| <Option> |
| <Option Name="Personality">Delphi.Personality</Option> |
| <Option Name="ProjectType">VCLApplication</Option> |
| <Option Name="Version">1.0</Option> |
| <Option Name="GUID">{F3F21AED-7127-43ED-AB54-5BE84B351EDB}</Option> |
| </Option> |
| </PersonalityInfo> |
| <Delphi.Personality> |
| <Source> |
| <Source Name="MainSource">Calender.dpr</Source> |
| </Source> |
| <FileVersion> |
| <FileVersion Name="Version">7.0</FileVersion> |
| </FileVersion> |
| <Compiler> |
| <Compiler Name="A">8</Compiler> |
| <Compiler Name="B">0</Compiler> |
| <Compiler Name="C">1</Compiler> |
| <Compiler Name="D">1</Compiler> |
| <Compiler Name="E">0</Compiler> |
| <Compiler Name="F">0</Compiler> |
| <Compiler Name="G">1</Compiler> |
| <Compiler Name="H">1</Compiler> |
| <Compiler Name="I">1</Compiler> |
| <Compiler Name="J">0</Compiler> |
| <Compiler Name="K">0</Compiler> |
| <Compiler Name="L">1</Compiler> |
| <Compiler Name="M">0</Compiler> |
| <Compiler Name="N">1</Compiler> |
| <Compiler Name="O">1</Compiler> |
| <Compiler Name="P">1</Compiler> |
| <Compiler Name="Q">0</Compiler> |
| <Compiler Name="R">0</Compiler> |
| <Compiler Name="S">0</Compiler> |
| <Compiler Name="T">0</Compiler> |
| <Compiler Name="U">0</Compiler> |
| <Compiler Name="V">1</Compiler> |
| <Compiler Name="W">0</Compiler> |
| <Compiler Name="X">1</Compiler> |
| <Compiler Name="Y">1</Compiler> |
| <Compiler Name="Z">1</Compiler> |
| <Compiler Name="ShowHints">True</Compiler> |
| <Compiler Name="ShowWarnings">True</Compiler> |
| <Compiler Name="UnitAliases">WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;</Compiler> |
| <Compiler Name="NamespacePrefix"></Compiler> |
| <Compiler Name="GenerateDocumentation">False</Compiler> |
| <Compiler Name="DefaultNamespace"></Compiler> |
| <Compiler Name="SymbolDeprecated">True</Compiler> |
| <Compiler Name="SymbolLibrary">True</Compiler> |
| <Compiler Name="SymbolPlatform">True</Compiler> |
| <Compiler Name="SymbolExperimental">True</Compiler> |
| <Compiler Name="UnitLibrary">True</Compiler> |
| <Compiler Name="UnitPlatform">True</Compiler> |
| <Compiler Name="UnitDeprecated">True</Compiler> |
| <Compiler Name="UnitExperimental">True</Compiler> |
| <Compiler Name="HResultCompat">True</Compiler> |
| <Compiler Name="HidingMember">True</Compiler> |
| <Compiler Name="HiddenVirtual">True</Compiler> |
| <Compiler Name="Garbage">True</Compiler> |
| <Compiler Name="BoundsError">True</Compiler> |
| <Compiler Name="ZeroNilCompat">True</Compiler> |
| <Compiler Name="StringConstTruncated">True</Compiler> |
| <Compiler Name="ForLoopVarVarPar">True</Compiler> |
| <Compiler Name="TypedConstVarPar">True</Compiler> |
| <Compiler Name="AsgToTypedConst">True</Compiler> |
| <Compiler Name="CaseLabelRange">True</Compiler> |
| <Compiler Name="ForVariable">True</Compiler> |
| <Compiler Name="ConstructingAbstract">True</Compiler> |
| <Compiler Name="ComparisonFalse">True</Compiler> |
| <Compiler Name="ComparisonTrue">True</Compiler> |
| <Compiler Name="ComparingSignedUnsigned">True</Compiler> |
| <Compiler Name="CombiningSignedUnsigned">True</Compiler> |
| <Compiler Name="UnsupportedConstruct">True</Compiler> |
| <Compiler Name="FileOpen">True</Compiler> |
| <Compiler Name="FileOpenUnitSrc">True</Compiler> |
| <Compiler Name="BadGlobalSymbol">True</Compiler> |
| <Compiler Name="DuplicateConstructorDestructor">True</Compiler> |
| <Compiler Name="InvalidDirective">True</Compiler> |
| <Compiler Name="PackageNoLink">True</Compiler> |
| <Compiler Name="PackageThreadVar">True</Compiler> |
| <Compiler Name="ImplicitImport">True</Compiler> |
| <Compiler Name="HPPEMITIgnored">True</Compiler> |
| <Compiler Name="NoRetVal">True</Compiler> |
| <Compiler Name="UseBeforeDef">True</Compiler> |
| <Compiler Name="ForLoopVarUndef">True</Compiler> |
| <Compiler Name="UnitNameMismatch">True</Compiler> |
| <Compiler Name="NoCFGFileFound">True</Compiler> |
| <Compiler Name="ImplicitVariants">True</Compiler> |
| <Compiler Name="UnicodeToLocale">True</Compiler> |
| <Compiler Name="LocaleToUnicode">True</Compiler> |
| <Compiler Name="ImagebaseMultiple">True</Compiler> |
| <Compiler Name="SuspiciousTypecast">True</Compiler> |
| <Compiler Name="PrivatePropAccessor">True</Compiler> |
| <Compiler Name="UnsafeType">False</Compiler> |
| <Compiler Name="UnsafeCode">False</Compiler> |
| <Compiler Name="UnsafeCast">False</Compiler> |
| <Compiler Name="OptionTruncated">True</Compiler> |
| <Compiler Name="WideCharReduced">True</Compiler> |
| <Compiler Name="DuplicatesIgnored">True</Compiler> |
| <Compiler Name="UnitInitSeq">True</Compiler> |
| <Compiler Name="LocalPInvoke">True</Compiler> |
| <Compiler Name="MessageDirective">True</Compiler> |
| <Compiler Name="CodePage"></Compiler> |
| </Compiler> |
| <Linker> |
| <Linker Name="MapFile">0</Linker> |
| <Linker Name="OutputObjs">0</Linker> |
| <Linker Name="GenerateHpps">False</Linker> |
| <Linker Name="ConsoleApp">1</Linker> |
| <Linker Name="DebugInfo">False</Linker> |
| <Linker Name="RemoteSymbols">False</Linker> |
| <Linker Name="GenerateDRC">False</Linker> |
| <Linker Name="MinStackSize">16384</Linker> |
| <Linker Name="MaxStackSize">1048576</Linker> |
| <Linker Name="ImageBase">4194304</Linker> |
| <Linker Name="ExeDescription"></Linker> |
| </Linker> |
| <Directories> |
| <Directories Name="OutputDir"></Directories> |
| <Directories Name="UnitOutputDir"></Directories> |
| <Directories Name="PackageDLLOutputDir"></Directories> |
| <Directories Name="PackageDCPOutputDir"></Directories> |
| <Directories Name="SearchPath"></Directories> |
| <Directories Name="Packages">vcl;rtl;vclx;VclSmp;vclshlctrls;dbrtl;adortl;vcldb;qrpt;bdertl;vcldbx;dsnap;cds;bdecds;teeui;teedb;tee;teeqr;ibxpress;visualclx;visualdbclx;inet;inetdb;nmfast;vclie;dbexpress;dbxcds;indy;dclOffice2k</Directories> |
| <Directories Name="Conditionals"></Directories> |
| <Directories Name="DebugSourceDirs"></Directories> |
| <Directories Name="UsePackages">False</Directories> |
| </Directories> |
| <Parameters> |
| <Parameters Name="RunParams"></Parameters> |
| <Parameters Name="HostApplication"></Parameters> |
| <Parameters Name="Launcher"></Parameters> |
| <Parameters Name="UseLauncher">False</Parameters> |
| <Parameters Name="DebugCWD"></Parameters> |
| <Parameters Name="Debug Symbols Search Path"></Parameters> |
| <Parameters Name="LoadAllSymbols">True</Parameters> |
| <Parameters Name="LoadUnspecifiedSymbols">False</Parameters> |
| </Parameters> |
| <Language> |
| <Language Name="ActiveLang"></Language> |
| <Language Name="ProjectLang">$00000000</Language> |
| <Language Name="RootDir"></Language> |
| </Language> |
| <VersionInfo> |
| <VersionInfo Name="IncludeVerInfo">False</VersionInfo> |
| <VersionInfo Name="AutoIncBuild">False</VersionInfo> |
| <VersionInfo Name="MajorVer">1</VersionInfo> |
| <VersionInfo Name="MinorVer">0</VersionInfo> |
| <VersionInfo Name="Release">0</VersionInfo> |
| <VersionInfo Name="Build">0</VersionInfo> |
| <VersionInfo Name="Debug">False</VersionInfo> |
| <VersionInfo Name="PreRelease">False</VersionInfo> |
| <VersionInfo Name="Special">False</VersionInfo> |
| <VersionInfo Name="Private">False</VersionInfo> |
| <VersionInfo Name="DLL">False</VersionInfo> |
| <VersionInfo Name="Locale">1031</VersionInfo> |
| <VersionInfo Name="CodePage">1252</VersionInfo> |
| </VersionInfo> |
| <VersionInfoKeys> |
| <VersionInfoKeys Name="CompanyName"></VersionInfoKeys> |
| <VersionInfoKeys Name="FileDescription"></VersionInfoKeys> |
| <VersionInfoKeys Name="FileVersion">1.0.0.0</VersionInfoKeys> |
| <VersionInfoKeys Name="InternalName"></VersionInfoKeys> |
| <VersionInfoKeys Name="LegalCopyright"></VersionInfoKeys> |
| <VersionInfoKeys Name="LegalTrademarks"></VersionInfoKeys> |
| <VersionInfoKeys Name="OriginalFilename"></VersionInfoKeys> |
| <VersionInfoKeys Name="ProductName"></VersionInfoKeys> |
| <VersionInfoKeys Name="ProductVersion">1.0.0.0</VersionInfoKeys> |
| <VersionInfoKeys Name="Comments"></VersionInfoKeys> |
| </VersionInfoKeys> |
| </Delphi.Personality> |
| </BorlandProject> |
| /Kalenderersatz/NoDoubleStart.dcu |
|---|
| Cannot display: file marked as a binary type. |
| svn:mime-type = application/octet-stream |
| Property changes: |
| Added: svn:mime-type |
| +application/octet-stream |
| \ No newline at end of property |
| /Kalenderersatz/Calender.dpr |
|---|
| 0,0 → 1,17 |
| program Calender; |
| uses |
| Forms, |
| Main in 'Main.pas' {MainForm}, |
| FullYearCalendar in 'FullYearCalendar.pas', |
| NoDoubleStart in 'NoDoubleStart.pas'; |
| {$R *.res} |
| begin |
| Application.Initialize; |
| Application.ShowMainForm := false; |
| Application.Title := 'Kalender'; |
| Application.CreateForm(TMainForm, MainForm); |
| Application.Run; |
| end. |
| /Kalenderersatz/Calender.dof |
|---|
| 0,0 → 1,90 |
| [FileVersion] |
| Version=6.0 |
| [Compiler] |
| A=8 |
| B=0 |
| C=1 |
| D=1 |
| E=0 |
| F=0 |
| G=1 |
| H=1 |
| I=1 |
| J=0 |
| K=0 |
| L=1 |
| M=0 |
| N=1 |
| O=1 |
| P=1 |
| Q=0 |
| R=0 |
| S=0 |
| T=0 |
| U=0 |
| V=1 |
| W=0 |
| X=1 |
| Y=1 |
| Z=1 |
| ShowHints=1 |
| ShowWarnings=1 |
| UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; |
| [Linker] |
| MapFile=0 |
| OutputObjs=0 |
| ConsoleApp=1 |
| DebugInfo=0 |
| RemoteSymbols=0 |
| MinStackSize=16384 |
| MaxStackSize=1048576 |
| ImageBase=4194304 |
| ExeDescription= |
| [Directories] |
| OutputDir= |
| UnitOutputDir= |
| PackageDLLOutputDir= |
| PackageDCPOutputDir= |
| SearchPath= |
| Packages=vcl;rtl;vclx;VclSmp;vclshlctrls;dbrtl;adortl;vcldb;qrpt;bdertl;vcldbx;dsnap;cds;bdecds;teeui;teedb;tee;teeqr;ibxpress;visualclx;visualdbclx;inet;inetdb;nmfast;vclie;dbexpress;dbxcds;indy;dclOffice2k |
| Conditionals= |
| DebugSourceDirs= |
| UsePackages=0 |
| [Parameters] |
| RunParams= |
| HostApplication= |
| Launcher= |
| UseLauncher=0 |
| DebugCWD= |
| [Language] |
| ActiveLang= |
| ProjectLang= |
| RootDir= |
| [Version Info] |
| IncludeVerInfo=0 |
| AutoIncBuild=0 |
| MajorVer=1 |
| MinorVer=0 |
| Release=0 |
| Build=0 |
| Debug=0 |
| PreRelease=0 |
| Special=0 |
| Private=0 |
| DLL=0 |
| Locale=1031 |
| CodePage=1252 |
| [Version Info Keys] |
| CompanyName= |
| FileDescription= |
| FileVersion=1.0.0.0 |
| InternalName= |
| LegalCopyright= |
| LegalTrademarks= |
| OriginalFilename= |
| ProductName= |
| ProductVersion=1.0.0.0 |
| Comments= |
| [Excluded Packages] |
| c:\programme\borland\delphi6\Bin\dclnet60.bpl=Borland Internet-Komponenten |
| c:\programme\borland\delphi6\Bin\dclsoap60.bpl=Borland Soap-Komponenten |
| /Kalenderersatz/TimeDate.ico |
|---|
| Cannot display: file marked as a binary type. |
| svn:mime-type = application/octet-stream |
| Property changes: |
| Added: svn:mime-type |
| +application/octet-stream |
| \ No newline at end of property |
| /Kalenderersatz/Calender.res |
|---|
| Cannot display: file marked as a binary type. |
| svn:mime-type = application/octet-stream |
| Property changes: |
| Added: svn:mime-type |
| +application/octet-stream |
| \ No newline at end of property |
| /Kalenderersatz/Main.pas |
|---|
| 0,0 → 1,207 |
| unit Main; |
| interface |
| uses |
| Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, |
| Dialogs, ComCtrls, ShellAPI, Menus; |
| const |
| WM_TASKABAREVENT = WM_USER+1; //Taskbar message |
| type |
| TMainForm = class(TForm) |
| PopupMenu1: TPopupMenu; |
| Anzeigen1: TMenuItem; |
| Beenden1: TMenuItem; |
| procedure FormDestroy(Sender: TObject); |
| procedure FormCreate(Sender: TObject); |
| procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); |
| procedure Anzeigen1Click(Sender: TObject); |
| procedure Beenden1Click(Sender: TObject); |
| private |
| RealClose: boolean; |
| procedure TaskbarEvent(var Msg: TMessage); |
| Message WM_TASKABAREVENT; |
| procedure OnQueryEndSession(var Msg: TWMQueryEndSession); |
| message WM_QUERYENDSESSION ; |
| procedure NotifyIconChange(dwMessage: Cardinal); |
| protected |
| cal: TMonthCalendar; |
| public |
| procedure Vordergrund; |
| end; |
| var |
| MainForm: TMainForm; |
| implementation |
| {$R *.dfm} |
| uses |
| CommCtrl, FullYearCalendar; |
| // Ref: http://www.delphi-fundgrube.de/faq01.htm |
| procedure TMainForm.TaskbarEvent(var Msg: TMessage); |
| var |
| Point: TPoint; |
| begin |
| { Die WM_TaskbarEvent-Message "Msg" gibt in Msg.LParam |
| das genaue Ereignis an. Msg.LParam kann folgende Werte für |
| Mausereignisse annehmen: |
| WM_MouseMove |
| WM_LButtonDown |
| WM_LButtonUp |
| WM_LButtonDblClk |
| WM_RButtonDown |
| WM_RButtonUp |
| WM_RButtonDblClk } |
| case Msg.LParam of |
| WM_LButtonDblClk: |
| begin |
| Vordergrund; |
| end; |
| WM_RButtonUp: |
| begin |
| // Rechtsklick |
| // Diese Zeile ist wichtig, damit das PopupMenu korrekt |
| // wieder geschlossen wird: |
| SetForegroundWindow(Handle); |
| // PopupMenu anzeigen: |
| GetCursorPos(Point); |
| PopupMenu1.Popup(Point.x, Point.y); |
| //oder ohne Variable Point: |
| //PopupMenu1.Popup(Mouse.CursorPos.x, Mouse.CursorPos.y); |
| end; |
| end; |
| end; |
| procedure TMainForm.NotifyIconChange(dwMessage: Cardinal); |
| var |
| NotifyIconData: TNotifyIconData; |
| begin |
| Fillchar(NotifyIconData,Sizeof(NotifyIconData),0); |
| NotifyIconData.cbSize := Sizeof(NotifyIconData); |
| NotifyIconData.Wnd := Handle; |
| NotifyIconData.uFlags := NIF_MESSAGE |
| or NIF_ICON |
| or NIF_TIP; |
| NotifyIconData.uCallbackMessage := WM_TASKABAREVENT; |
| NotifyIconData.hIcon := Application.Icon.Handle; |
| NotifyIconData.szTip := 'Kalender'; |
| Shell_NotifyIcon(dwMessage, @NotifyIconData); |
| end; |
| procedure TMainForm.FormDestroy(Sender: TObject); |
| begin |
| cal.Free; |
| NotifyIconChange(NIM_DELETE); |
| end; |
| procedure TMainForm.FormCreate(Sender: TObject); |
| begin |
| NotifyIconChange(NIM_ADD); |
| cal := TFullYearCalendar.Create(Self); |
| cal.Parent := Self; |
| cal.WeekNumbers := true; |
| ClientWidth := cal.Width; |
| ClientHeight := cal.Height; |
| end; |
| // Ref: http://www.swissdelphicenter.ch/de/showcode.php?id=261 |
| function ForceForegroundWindow(hwnd: THandle): Boolean; |
| const |
| SPI_GETFOREGROUNDLOCKTIMEOUT = $2000; |
| SPI_SETFOREGROUNDLOCKTIMEOUT = $2001; |
| var |
| ForegroundThreadID: DWORD; |
| ThisThreadID: DWORD; |
| timeout: DWORD; |
| begin |
| if IsIconic(hwnd) then ShowWindow(hwnd, SW_RESTORE); |
| if GetForegroundWindow = hwnd then Result := True |
| else |
| begin |
| // Windows 98/2000 doesn't want to foreground a window when some other |
| // window has keyboard focus |
| if ((Win32Platform = VER_PLATFORM_WIN32_NT) and (Win32MajorVersion > 4)) or |
| ((Win32Platform = VER_PLATFORM_WIN32_WINDOWS) and |
| ((Win32MajorVersion > 4) or ((Win32MajorVersion = 4) and |
| (Win32MinorVersion > 0)))) then |
| begin |
| // Code from Karl E. Peterson, www.mvps.org/vb/sample.htm |
| // Converted to Delphi by Ray Lischner |
| // Published in The Delphi Magazine 55, page 16 |
| Result := False; |
| ForegroundThreadID := GetWindowThreadProcessID(GetForegroundWindow, nil); |
| ThisThreadID := GetWindowThreadPRocessId(hwnd, nil); |
| if AttachThreadInput(ThisThreadID, ForegroundThreadID, True) then |
| begin |
| BringWindowToTop(hwnd); // IE 5.5 related hack |
| SetForegroundWindow(hwnd); |
| AttachThreadInput(ThisThreadID, ForegroundThreadID, False); |
| Result := (GetForegroundWindow = hwnd); |
| end; |
| if not Result then |
| begin |
| // Code by Daniel P. Stasinski |
| SystemParametersInfo(SPI_GETFOREGROUNDLOCKTIMEOUT, 0, @timeout, 0); |
| SystemParametersInfo(SPI_SETFOREGROUNDLOCKTIMEOUT, 0, TObject(0), |
| SPIF_SENDCHANGE); |
| BringWindowToTop(hwnd); // IE 5.5 related hack |
| SetForegroundWindow(hWnd); |
| SystemParametersInfo(SPI_SETFOREGROUNDLOCKTIMEOUT, 0, TObject(timeout), SPIF_SENDCHANGE); |
| end; |
| end |
| else |
| begin |
| BringWindowToTop(hwnd); // IE 5.5 related hack |
| SetForegroundWindow(hwnd); |
| end; |
| Result := (GetForegroundWindow = hwnd); |
| end; |
| end; |
| procedure TMainForm.Vordergrund; |
| begin |
| Show; |
| ForceForegroundWindow(Handle); |
| end; |
| procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean); |
| begin |
| Hide; |
| CanClose := RealClose; |
| end; |
| procedure TMainForm.OnQueryEndSession; |
| begin |
| RealClose := true; |
| Close; |
| Msg.Result := 1; |
| end; |
| procedure TMainForm.Anzeigen1Click(Sender: TObject); |
| begin |
| Vordergrund; |
| end; |
| procedure TMainForm.Beenden1Click(Sender: TObject); |
| begin |
| RealClose := true; |
| Close; |
| end; |
| end. |
| /Kalenderersatz/NoDoubleStart.pas |
|---|
| 0,0 → 1,25 |
| unit NoDoubleStart; |
| interface |
| implementation |
| uses |
| Windows, SysUtils, Forms; |
| var |
| mHandle: THandle; |
| Initialization |
| mHandle := CreateMutex(nil, True, 'ViaThinkSoft-Calendar'); |
| if GetLastError = ERROR_ALREADY_EXISTS then |
| begin |
| Halt; |
| end; |
| finalization |
| if mHandle <> 0 then |
| begin |
| CloseHandle(mHandle) |
| end; |
| end. |
| /Kalenderersatz/FullYearCalendar.dcu |
|---|
| Cannot display: file marked as a binary type. |
| svn:mime-type = application/octet-stream |
| Property changes: |
| Added: svn:mime-type |
| +application/octet-stream |
| \ No newline at end of property |
| /Kalenderersatz/Main.dfm |
|---|
| 0,0 → 1,34 |
| object MainForm: TMainForm |
| Left = 194 |
| Top = 148 |
| BorderIcons = [biSystemMenu, biMinimize] |
| Caption = 'Kalender' |
| ClientHeight = 392 |
| ClientWidth = 730 |
| Color = clBtnFace |
| Font.Charset = DEFAULT_CHARSET |
| Font.Color = clWindowText |
| Font.Height = -11 |
| Font.Name = 'MS Sans Serif' |
| Font.Style = [] |
| OldCreateOrder = False |
| Position = poScreenCenter |
| OnCloseQuery = FormCloseQuery |
| OnCreate = FormCreate |
| OnDestroy = FormDestroy |
| PixelsPerInch = 96 |
| TextHeight = 13 |
| object PopupMenu1: TPopupMenu |
| Left = 8 |
| Top = 8 |
| object Anzeigen1: TMenuItem |
| Caption = '&Anzeigen' |
| Default = True |
| OnClick = Anzeigen1Click |
| end |
| object Beenden1: TMenuItem |
| Caption = '&Beenden' |
| OnClick = Beenden1Click |
| end |
| end |
| end |
| /Kalenderersatz/Main.ddp |
|---|
| Cannot display: file marked as a binary type. |
| svn:mime-type = application/octet-stream |
| Property changes: |
| Added: svn:mime-type |
| +application/octet-stream |
| \ No newline at end of property |
| /Kalenderersatz/Calender.cfg |
|---|
| 0,0 → 1,38 |
| -$A8 |
| -$B- |
| -$C+ |
| -$D+ |
| -$E- |
| -$F- |
| -$G+ |
| -$H+ |
| -$I+ |
| -$J- |
| -$K- |
| -$L+ |
| -$M- |
| -$N+ |
| -$O+ |
| -$P+ |
| -$Q- |
| -$R- |
| -$S- |
| -$T- |
| -$U- |
| -$V+ |
| -$W- |
| -$X+ |
| -$YD |
| -$Z1 |
| -cg |
| -AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; |
| -H+ |
| -W+ |
| -M |
| -$M16384,1048576 |
| -K$00400000 |
| -LE"C:\Dokumente und Einstellungen\Daniel Marschall\Eigene Dateien\Borland Studio-Projekte\Bpl" |
| -LN"C:\Dokumente und Einstellungen\Daniel Marschall\Eigene Dateien\Borland Studio-Projekte\Bpl" |
| -w-UNSAFE_TYPE |
| -w-UNSAFE_CODE |
| -w-UNSAFE_CAST |
| /Kalenderersatz/Calender.exe |
|---|
| Cannot display: file marked as a binary type. |
| svn:mime-type = application/octet-stream |
| Property changes: |
| Added: svn:mime-type |
| +application/octet-stream |
| \ No newline at end of property |
| /Kalenderersatz/Main.dcu |
|---|
| Cannot display: file marked as a binary type. |
| svn:mime-type = application/octet-stream |
| Property changes: |
| Added: svn:mime-type |
| +application/octet-stream |
| \ No newline at end of property |