├── License.txt ├── PathLocate.chm ├── README.txt ├── Readme.md ├── clean_FPC.bat ├── htmlhelp ├── Contents.hhc ├── Index.hhk ├── PathLocate.hhp ├── compile.bat ├── html │ ├── PathLocateHelp.clpprj │ ├── PathLocateHelp_clcs.csprj │ ├── ex_linux.png │ ├── ex_msvcrt.png │ ├── ex_powershell.png │ ├── examples.html │ ├── license.html │ ├── links.css │ ├── main.css │ ├── overview.html │ ├── standard.css │ ├── usage.html │ └── version.html └── open_with_ms-hhw.bat └── src ├── Info.txt ├── PLOC.App.pas ├── PLOC.PROCS.pas ├── PLOC.Types.pas ├── PathLocate.ctpr ├── PathLocate.ppr ├── PathLocate.res └── we ├── Readme.md ├── btypes.pas ├── hash.pas ├── md5.pas ├── mem_util.pas ├── sha1.pas ├── sha256.pas └── std.inc /License.txt: -------------------------------------------------------------------------------- 1 | This software is provided "as-is" and without warranty of any kind, express, implied or otherwise, including without limitation, any warranty of merchantability or fitness for a particular purpose. 2 | 3 | Permission is granted to anyone to use this software without any limitation, for any purpose, including commercial use. 4 | 5 | Jacek Pazera 6 | -------------------------------------------------------------------------------- /PathLocate.chm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jackdp/PathLocate/68e633e9d859ea1f64848ec5bda26ebefe48dde2/PathLocate.chm -------------------------------------------------------------------------------- /README.txt: -------------------------------------------------------------------------------- 1 | PathLocate 1.1 2018.03.19 2 | 3 | A small command line utility that allows you to quickly search for files located in directories listed in the %PATH% environment variable. 4 | 5 | The program allows you to enter many names/masks of files on one command line, limit the number of returned files, ignore or take into account the size of characters, calculate CRC32 checksums, display the last modification time of files, their size, VersionInfo block from executable files (on Windows) and other. 6 | 7 | System: Windows 32-bit, Windows 64-bit, Linux 32-bit, Linux 64-bit 8 | License: Freeware, Open-Source 9 | 10 | 11 | http://www.pazera-software.com/products/path-locate/ 12 | 13 | -------------------------------------------------------------------------------- /Readme.md: -------------------------------------------------------------------------------- 1 | # PathLocate 2 | 3 | ## Overview 4 | 5 | PathLocate is a small command line utility that allows you to quickly search for files located in directories listed in the `PATH` environment variable. 6 | 7 | The program allows you to enter many names/masks of files on one command line, limit the number of returned files, ignore or take into account the size of characters, calculate CRC32 checksums, SHA-1 and SHA-2 hashes, display the last modification time of files, their size, VersionInfo block from executable files (on Windows) and other. 8 | 9 | ## Download 10 | 11 | Source: https://github.com/jackdp/PathLocate 12 | 13 | Binary (Windows 32-bit, Windows 64-bit, Linux 32-bit, Linux 64-bit): http://www.pazera-software.com/products/path-locate/ 14 | 15 | ## Documentation 16 | 17 | Full documentation available at https://www.pazera-software.com/doc/path-locate/help.html 18 | 19 | ## Compilation 20 | 21 | > Build and tested on CodeTyphon 6.40 with FPC 3.1.1 22 | 23 | To compile, you need: 24 | - [CodeTyphon Programming Studio](http://pilotlogic.com/sitejoom/). After small modifications, the program can also be compiled in the [Lazarus IDE](https://www.lazarus-ide.org/). 25 | - [JPL.CmdLineParser](https://github.com/jackdp/JPL.CmdLineParser) unit. 26 | - A several Pascal units from my library [JPLib](https://github.com/jackdp/JPLib/). 27 | - Mini-FPC [MFPC](https://github.com/jackdp/MFPC). 28 | - Wolfgang Ehrhardt's [hashing units](http://www.wolfgang-ehrhardt.de/crchash_en.html) (all files in the [src/we](src/we) directory). 29 | 30 | How to build: 31 | 1. Open `src\PathLocate.ctpr` file with CodeTyphon. 32 | 1. Set build mode for your destination system. 33 | Select menu `Project -> Project Options...` A new window will appear. 34 | In the tree view (on the left), select `Compiler Options`. 35 | At the top of this window you can select the build mode from the dropdown list. 36 | Choose: `Release Win32`, `Release Win64`, `Release Lin32` or `Release Lin64`. 37 | 3. Build project (menu `Run->Build`). 38 | 39 | ## Changelog / Releases 40 | 41 | **Version 1.1** (2018.03.19) 42 | - Compilation in a new version of the CodeTyphon (6.40). 43 | - [+] Calculation of MD5, SHA-1 and SHA-2-256 checksums. Switches: `--md5` `--sha1` `--sha2` 44 | - [+] Highlighting of executable files: EXE, DLL, BAT, CMD, BPL (on Windows), and SH, SO (on Linux). Switches: `-he` `-hd` `-hb` `-hc` `-hp` `-hs` `-hl` 45 | - [+] Highlighting the text provided by the user. Switches: `-hus` `-hus2` 46 | - [+] Sorting. Switches: `-sb` `-sd` 47 | - [+] Displaying the list of directories specified in the **PATH** environment variable. Switch `-ld` 48 | - [+] Long format switch: `--long`. 49 | - [+] The user can define the text used to separate categories of information. Switches: `-sl` `-sdt`. 50 | - [+] Displaying more detailed information about errors. Switch `-err` 51 | - [+] Displaying the creation (Windows only), last write and last access time of found files. Switches: `-dc` `-dw` `-da` 52 | - [+] The ability to display file attributes on Windows system. Switch: -a 53 | - [+] Displaying the short version info (and nothing more). It can be useful for detecting the PathLocate version from batch files. Switch `-vs` 54 | - [+] [Linux] Detecting if the output is a character device (terminal, printer). If so, the PathLocate will use ANSI escape codes to display colors. If not, ANSI codes will not be generated by the program. As a result, the output data stream can be redirected to a file/pipe, and it will not be "cluttered" with unnecessary data. 55 | 56 | **Version 1.0** (2018.01.25) 57 | Initial release. 58 | 59 | ## Note 60 | 61 | This program was made for my private use, but it may also be useful to someone. 62 | 63 | PathLocate can be useful for administrators to quickly locate executable files, check their version, as well as in batch files for making decisions in the absence of any files necessary for the proper operation of the script. 64 | -------------------------------------------------------------------------------- /clean_FPC.bat: -------------------------------------------------------------------------------- 1 | @echo off 2 | 3 | del /s *.ppu 4 | del /s *.o 5 | del /s *.rsj 6 | del /s *.or 7 | -------------------------------------------------------------------------------- /htmlhelp/Contents.hhc: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 36 | 37 | 38 | -------------------------------------------------------------------------------- /htmlhelp/Index.hhk: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | -------------------------------------------------------------------------------- /htmlhelp/PathLocate.hhp: -------------------------------------------------------------------------------- 1 | [OPTIONS] 2 | Compatibility=1.1 or later 3 | Compiled file=PathLocate.chm 4 | Contents file=Contents.hhc 5 | Default topic=html\overview.html 6 | Display compile progress=Yes 7 | Full-text search=Yes 8 | Language=0x0409 English (United States) 9 | Title=PathLocate 10 | Error log file= 11 | Full text search stop list file= 12 | Index file=Index.hhk 13 | Binary TOC=No 14 | Auto index=No 15 | Binary Index=No 16 | Create CHI file=No 17 | Display compile notes=Yes 18 | Default window=win1 19 | Enhanced decompilation=No 20 | Flat=No 21 | Default Font=Segoe UI,9,0 22 | 23 | [WINDOWS] 24 | win1="PathLocate 1.1 Help","Contents.hhc",,"html\overview.html","html\overview.html",,,,,0x00063520,264,0x0010387E,[31,12,928,627],,,,0,0,0,0 25 | 26 | [FILES] 27 | Contents.hhc 28 | html\examples.html 29 | html\license.html 30 | html\overview.html 31 | html\usage.html 32 | html\version.html 33 | 34 | [ALIAS] 35 | IDH_overview=html\overview.html 36 | IDH_usage=html\usage.html 37 | IDH_examples=html\examples.html 38 | IDH_license=html\license.html 39 | IDH_version=html\version.html 40 | 41 | [MAP] 42 | #define IDH_overview 1 43 | #define IDH_usage 2 44 | #define IDH_examples 3 45 | #define IDH_license 4 46 | #define IDH_version 5 47 | 48 | -------------------------------------------------------------------------------- /htmlhelp/compile.bat: -------------------------------------------------------------------------------- 1 | @echo off 2 | 3 | set hhc=E:\Programs\HTML Help Workshop\hhc.exe 4 | 5 | "%hhc%" PathLocate.hhp -------------------------------------------------------------------------------- /htmlhelp/html/PathLocateHelp.clpprj: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | -------------------------------------------------------------------------------- /htmlhelp/html/PathLocateHelp_clcs.csprj: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | -------------------------------------------------------------------------------- /htmlhelp/html/ex_linux.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jackdp/PathLocate/68e633e9d859ea1f64848ec5bda26ebefe48dde2/htmlhelp/html/ex_linux.png -------------------------------------------------------------------------------- /htmlhelp/html/ex_msvcrt.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jackdp/PathLocate/68e633e9d859ea1f64848ec5bda26ebefe48dde2/htmlhelp/html/ex_msvcrt.png -------------------------------------------------------------------------------- /htmlhelp/html/ex_powershell.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jackdp/PathLocate/68e633e9d859ea1f64848ec5bda26ebefe48dde2/htmlhelp/html/ex_powershell.png -------------------------------------------------------------------------------- /htmlhelp/html/examples.html: -------------------------------------------------------------------------------- 1 |  2 | 3 | 4 | 5 | Examples - PathLocate 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 |

Examples

16 | 17 |
18 | 19 |

20 | 21 | 22 | 23 |
    24 | 25 | 26 |
  1. 27 | Show all files from directories listed in the %PATH% environment variable: 28 |
      29 |
    • Windows: pathlocate *
      • 30 |
    • Linux: pathlocate "*"
      • 31 |
    32 |
    2. 33 | 34 | 35 | 36 |
  2. 37 | Show the first 10 EXE and/or DLL files from directories listed in the %PATH% environment variable: 38 |
    39 | pathlocate *.exe *.dll -l 10 40 |
    41 |
    3. 42 | 43 | 44 | 45 |
  3. 46 | Display VersionInfo block from the msvcrt.dll file and calculate its CRC32 cheksum: 47 |
    48 | pathlocate msvcrt.dll -vi --crc 49 |
    50 | Result: 51 |
    52 | 53 |
    54 |
    4. 55 | 56 | 57 | 58 |
  4. 59 | Show executables (EXE) and batch scripts (BAT) that contain powershell in the name, and files that start with pwsh string. Use long format (-l). Highlight string 6.0.1 and v1.0. 60 |
    61 | pathlocate *powershell*.exe *powershell*.bat pwsh* -l -hus "6.0.1" -hus2 "v1.0" 62 |
    63 | Result: 64 |
    65 | example 66 |
    67 |
    5. 68 | 69 | 70 | 71 |
  5. 72 | Show all files that contain the fpc string in the name. 73 | Show file size in human readable format (-S), show numbers(-n), show summary (-u). 74 | Highlight string local and usr/bin/. 75 |
    76 | pathlocate *fpc* -S -n -u -hus local -hus2 "usr/bin/" 77 |
    78 | Result: 79 |
    80 | PathLocate on Linux 81 |
    82 |
    6. 83 | 84 | 85 | 86 |
  6. 87 | Checking in the batch file whether the 7z archiver can be run: 88 | 
     89 | 
 90 | @echo off
 91 | 
 92 | pathlocate 7z.exe > nul
 93 | 
 94 | if %errorlevel% EQU 0 goto LBL_ALL_OK
 95 | if %errorlevel% EQU 1 goto LBL_ERROR
 96 | if %errorlevel% EQU 2 goto LBL_NO_FILES
 97 | 
 98 | :LBL_ALL_OK
 99 | echo  All OK! The 7z.exe file exists. We can start archiving. 
100 | rem ... do something ...
101 | goto LBL_END
102 | 
103 | 
104 | :LBL_ERROR
105 | echo  Wrong syntax or another error! 
106 | goto LBL_END
107 | 
108 | 
109 | :LBL_NO_FILES
110 | echo  No 7z archiver found. Compression can not be started. 
111 | goto LBL_END
112 | 
113 | 
114 | :LBL_END
115 | echo  --------- END ----------- 
116 |
    117 |
    7. 118 | 119 | 120 |
121 | 122 | 123 | 124 | 125 | 126 | 127 |
128 | 129 | 130 | 131 | 134 | 135 | 136 | 137 | 138 | -------------------------------------------------------------------------------- /htmlhelp/html/license.html: -------------------------------------------------------------------------------- 1 |  2 | 3 | 4 | 5 | License - PathLocate 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 |

License

16 | 17 |
18 | 19 | 20 |

21 | 22 |

23 | This software is provided "as-is" and without warranty of any kind, express, implied or otherwise, including without limitation, any warranty of merchantability or fitness for a particular purpose. 24 |

25 | 26 |

27 | Permission is granted to anyone to use this software without any limitation, for any purpose, including commercial use. 28 |

29 | 30 | Jacek Pazera 31 | 32 | 33 | 34 |
35 | 36 | 37 | 38 | 41 | 42 | 43 | 44 | 45 | -------------------------------------------------------------------------------- /htmlhelp/html/links.css: -------------------------------------------------------------------------------- 1 | a { 2 | color: #003EF4; 3 | text-decoration: none; 4 | } 5 | a:visited { 6 | color: #096AB3; 7 | text-decoration: none; 8 | } 9 | a:hover { 10 | color: #003EF4; 11 | text-decoration: underline; 12 | } 13 | 14 | 15 | #footer a { 16 | color: #FFFFee; font-size: 8pt; font-family: tahoma; 17 | } 18 | 19 | 20 | 21 | -------------------------------------------------------------------------------- /htmlhelp/html/main.css: -------------------------------------------------------------------------------- 1 | #hlp_header { 2 | padding: 5px; 3 | text-align: left; 4 | background-color: silver; 5 | color: white; 6 | border: 1px solid #808080; 7 | } 8 | 9 | #hlp_main { 10 | background-color: #ffffff; text-align: left; 11 | margin: 20px; 12 | } 13 | 14 | 15 | 16 | #hlp_footer { 17 | margin: 10px 20px 10px 20px; 18 | padding: 5px; 19 | background-color: #ffffff; border-top: 1px solid #dfdfdf; 20 | font-size: 8pt; font-family: verdana; color: #ffffff; text-align: center; 21 | } 22 | #hlp_footer td { 23 | color: #ffffff; text-align: center; font-size: 9pt; 24 | } 25 | 26 | #contents { margin: 10px; } 27 | #contents div { margin-left: 20px; margin-top: 8px; font-weight: normal; } 28 | #contents div div { margin-left: 20px; margin-top: 2px; font-weight: normal; } 29 | #contents div div div { margin-left: 20px; margin-top: 0px; } 30 | 31 | .win_only {color: #eefaff; background-color: #0b66ee; padding: 1px 2px 1px 2px; font-family: 'Fira Mono',Monaco,monospace; font-size: 9pt; font-weight: normal;} 32 | .lin_only {color: #c5fac8; background-color: #45b43f; padding: 1px 2px 1px 2px; font-family: 'Fira Mono',Monaco,monospace; font-size: 9pt; font-weight: normal;} 33 | 34 | .cmd_line {color: black; background-color:#e8e8e8; font-size: 10pt; font-family: 'fira mono',consolas,'courier new'; padding: 1px 5px 1px 5px;} 35 | .cmd_line_block {margin: 10px 0px 10px 10px;} 36 | 37 | .example {margin: 30px 0px 40px 0px;} 38 | .code_inline { font-size: 10pt; font-family: 'fira mono',consolas,'courier new'; color: #721e0c; background-color:#ffefc4; padding:1px 2px 1px 2px;} 39 | 40 | .tdvl { text-align: right; background-color: #f0f0f0; padding: 4px 10px 4px 10px; } 41 | .tdvr { text-align: left; padding: 4px 10px 4px 10px; } 42 | 43 | .spacer1 { height: 10px; } 44 | .hlp_sep1 { border-top: 1px solid #dfdfdf; margin-top: 10px; margin-bottom: 8px; } 45 | .hlp_kw1 { font-style: italic; } 46 | .hlp_kw2 { font-weight: bold; } 47 | .hlp_img_title { font-weight: bold; margin: 4px; text-align: center; } 48 | 49 | .hlp_ActName { margin-left: 20px; font-weight: bold; margin-top: 10px; } 50 | .hlp_ActDesc { margin-left: 40px; } 51 | .hlp_ImgDesc { font-weight: bold; } 52 | 53 | .hlpDef { font-weight: bold; margin-top: 8px; margin-bottom: 4px; } 54 | .hlpDesc { margin-left: 20px; } 55 | 56 | /* --------------- TABLES ---------------- */ 57 | .tableCL { border: 1px solid #cdcdcd; border-collapse: collapse; } 58 | .thCL { padding: 3px; padding-right: 6px; padding-left: 6px; font-family: calibri; font-size: 14px; font-weight: bold; background-color: #e4e4e4; border: 1px solid #cdcdcd; } 59 | .tdCL_Def { font-weight: bold; text-align: left; font-size: 12px; border: 1px solid #d8d8d8; padding: 4px; } 60 | .tdCL_Switch { font-weight: bold; text-align: left; font-size: 13px; font-family: 'fira mono',consolas,'courier new'; border: 1px solid #d8d8d8; padding: 5px; white-space: nowrap; } 61 | .tdCL_Ind { font-weight: bold; text-align: center; font-size: 13px; font-family: 'fira mono',consolas,'courier new'; border: 1px solid #d8d8d8; padding: 4px; } 62 | .tdCL_Desc { text-align:left; border: 1px solid #d8d8d8; padding: 5px; } 63 | 64 | 65 | /* ///////////////// INTERFACE ////////////// */ 66 | .key { border: 1px solid #aaaaaa; padding: 0px 4px 1px 4px; background-color: #eeeeee; font-size: 12px; } 67 | .panel { font-family: arial; font-weight: bold; font-size: 1.2em; } 68 | .button { border: 1px solid #bbbbbb; padding: 0px 4px 1px 4px; background-color: #eeeeee; font-size: 1.0em; } 69 | .menu { font-style: italic; font-weight: bold; font-family: arial; font-size: 1.0em; } 70 | .menuitem { font-style: italic; font-weight: bold; font-family: arial; font-size: 1.0em; } 71 | .list { font-family: arial; font-weight: bold; font-size: 1.0em; } 72 | .listitem { font-family: arial; font-weight: bold; font-size: 1.0em; } 73 | .option { font-family: arial; font-weight: bold; font-size: 1.0em; } 74 | .window { font-family: arial; font-weight: bold; font-size: 1.0em; } 75 | .filename { font-family: 'fira mono',consolas,'courier new'; font-weight: bold; font-size: 1.1em; } 76 | 77 | /* ///////////////// LANGUAGE ////////////// */ 78 | .lng_comm {color: #443333; background-color: #d0d0d0; font-family: 'fira mono','courier new';} 79 | .lng_direct {color: green;} 80 | .lng_key {font-weight: bold; color: black; font-family: 'fira mono','courier new';} 81 | .lng_num {color: red; font-family: 'fira mono','courier new';} 82 | .lng_str {color: blue; font-family: 'fira mono','courier new';} 83 | .lng_sym {color: maroon; font-family: 'fira mono','courier new';} 84 | 85 | .pas_assem { color: teal; font-family: 'fira mono','courier new';} 86 | 87 | .bat_label {color: #552d60; font-family: 'fira mono',consolas,'courier new';} 88 | .bat_str {color: #0d1e44; background-color: #caebfb; font-family: 'fira mono',consolas,'courier new';} 89 | .bat_var {color: green;} -------------------------------------------------------------------------------- /htmlhelp/html/overview.html: -------------------------------------------------------------------------------- 1 |  2 | 3 | 4 | 5 | PathLocate - Overview 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 |

Overview

16 | 17 |
18 | 19 | 20 | 21 | 22 |

23 | 24 | 25 |

PathLocate

26 | 27 |

28 | PathLocate is a small command line utility that allows you to quickly search for files located in directories listed in the PATH environment variable. 29 |

30 | 31 |

32 | The program allows you to enter many names/masks of files on one command line, limit the number of returned files, ignore or take into account the size of characters, calculate CRC32 checksums, display the last modification time of files, their size, VersionInfo block from executable files (on Windows) and other. 33 |

34 | 35 |

36 | PathLocate is a free and open-source software and can be used without any limitation, for any purpose, including commercial use. 37 |

38 | 39 | 40 | 41 | 42 |

43 | 44 | 45 |

Portability

46 | 47 |

48 | The application does not use registry, does not alter any system settings, does not need to work any additional runtime libraries or frameworks. 49 |

50 | 51 |

52 | You can copy executable file (PathLocate.exe on Windows, pathlocate on Linux) to USB drive, and run the program from that drive on other computers. 53 |

54 | 55 | 56 | 57 |
58 | 59 | 60 | 61 | 64 | 65 | 66 | 67 | 68 | -------------------------------------------------------------------------------- /htmlhelp/html/standard.css: -------------------------------------------------------------------------------- 1 | /* ----------------------- RESETS ------------------------- */ 2 | form { margin: 0px; padding: 0px; border: 0px; } 3 | fieldset { margin: 0px; padding: 0px; border: 0px; } 4 | /* ul { margin: 0px; padding: 0px; border: 0px; } */ 5 | td { margin: 0px; padding: 0px; border: 0px; } 6 | /* -------------------------------------------------------- */ 7 | 8 | body { 9 | margin: 6px; 10 | padding: 0px; 11 | font-family: verdana; 12 | font-size: 10pt; 13 | background-color: #FFFFFF; 14 | } 15 | 16 | /* img {margin: 0px auto; display:block;} */ 17 | 18 | li { 19 | padding-top: 1px; 20 | padding-bottom: 1px; 21 | } 22 | 23 | pre { margin: 0xp; padding: 0px; font-size: 10pt; font-family: 'fira mono',consolas,'courier new';} 24 | code { font-size: 10pt; font-family: 'fira mono',consolas,'courier new'; } 25 | 26 | ol { margin: 0px; padding-top: 0px; } 27 | ul { margin: 0px; padding-top: 0px; } 28 | 29 | table { border: 1px solid #cdcdcd; border-collapse: collapse; } 30 | th { padding: 3px; padding-right: 6px; padding-left: 6px; font-family: calibri; font-size: 14px; font-weight: bold; background-color: #e4e4e4; border: 1px solid #cdcdcd; } 31 | td { text-align: center; border: 1px solid #d8d8d8; padding: 4px; margin: 0px; } 32 | 33 | h1 { 34 | font-family: calibri,arial; 35 | font-size: 20pt; 36 | font-weight: bold; 37 | padding: 0px; 38 | color: #301010; 39 | margin: 0px; 40 | margin-top: 10px; 41 | text-align: center; 42 | } 43 | h2 { 44 | font-family: calibri,arial; 45 | font-size: 17pt; 46 | font-weight: bold; 47 | padding: 0px; 48 | margin: 0px; 49 | margin-top: 16px; 50 | margin-bottom: 0px; 51 | text-align: left; 52 | } 53 | h3 { 54 | font-family: calibri,arial; 55 | font-size: 14pt; 56 | padding: 8px; 57 | padding-left: 0px; 58 | margin: 0px; 59 | color: #301010; 60 | text-align: left; 61 | } 62 | 63 | h4 { 64 | font-family: calibri,arial; 65 | font-size: 13pt; 66 | padding: 8px; 67 | padding-left: 0px; 68 | margin: 0px; 69 | color: #301010; 70 | text-align: left; 71 | } 72 | 73 | p { padding: 0px; margin: 0px; margin-top: 6px; margin-bottom: 6px; } -------------------------------------------------------------------------------- /htmlhelp/html/usage.html: -------------------------------------------------------------------------------- 1 |  2 | 3 | 4 | 5 | Usage - PathLocate 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 |

Usage

15 | 16 | 17 | 18 |
19 | 20 |

21 | 22 | 23 | 24 | 25 | 26 | 27 |

28 | PathLocate.exe FILES [-c] [-n] [-s] [-S] [-dc] [-dw] [-da] [-a] [-vi] [-u] [-of=s|l|w] [-l] [-cs=1|0] [-sd=a|d] [-sb=[name|size|dw|dc|da]] [-hus=STR] [-hus2=STR] [-husc=[1|0]] [-he] [-hd] [-hb] [-hc] [-hp] [-hs] [-hl] [-hn] [-lm=n|X|fX|lX] [--crc] [--md5] [--sha1] [--sha2] [-ld] [-err=[1|0]] [-h] [-hh] [-V] [-vs] [--home] 29 |

30 | 31 | 32 | 33 | 34 |

35 | 36 | 37 | 38 | 39 | 40 | 41 |

Options

42 | 43 |

44 | Mandatory arguments to long options are mandatory for short options too.
45 | Options are case-sensitive. Options in square brackets are optional.
46 | All parameters that do not start with the "-" or "/" sign are treated as file names/masks.
47 | Options and input files can be placed in any order, but -- (double dash)
48 | indicates the end of parsing options and all subsequent parameters are treated as file names/masks. 49 |

50 | 51 | 52 | 53 |

54 | FILES - Any combination of file names / masks. E.g.: picture.png *build*.log "long file name*" 55 |

56 | 57 | 58 | 59 | 60 | 61 | 62 |

Main options

63 | 64 | 65 | 66 | 67 | 68 | 69 | 70 | 71 | 72 | 73 | 74 | 75 | 76 | 77 | 78 | 79 | 80 | 81 | 82 | 83 | 84 | 85 | 92 | 93 | 94 | 95 | 96 | 97 | 98 | 99 | 100 | 101 | 102 | 103 | 104 | 105 | 106 | 107 | 108 | 109 | 110 | 111 | 112 | 113 | 114 | 115 | 116 | 117 | 118 | 119 | 120 | 121 | 122 | 123 | 124 | 125 | 126 | 127 | 128 | 129 | 130 | 131 | 132 | 133 | 134 | 135 | 136 | 137 | 138 | 139 | 140 | 141 | 149 | 150 | 151 | 152 | 153 | 154 | 155 | 156 | 157 | 158 | 159 | 160 | 161 | 162 | 163 | 164 | 165 | 166 | 167 | 168 | 169 | 170 | 171 | 172 |
Switch (Option)Description
-c, --curr-dirAlso searches for files in the current directory.
-ld, --list-dirsList directories specified in the %PATH% and exit. You can sort list of directories with -sb switch in ascending (-sd=a) or descending (-sd=d) order.
-s, --case-sensitive=1|0Case sensitive. 1 - enabled, 0 - disabled. Default: 0 on Windows, 1 on Linux. Used when searching and sorting files.
-lm, --limit=n|X|fX|lX 86 | File count limit:
87 |   n | none - no limit (show all files). Default.
88 |   X - show only the first X files.
89 |   fX | firstX - as above
90 |   lX | lastX - show only the last X files. 91 |
-n, --numbersDisplay file numbers.
-s, --size-bytesDisplay file size in bytes.
-S, --sizeDisplay file size in human readable format (e.g. 8KB, 16MB).
-dc, --date-creationWin Display file creation time.
-dw, --date-writeDisplay file last write (modification) time.
-da, --date-accessDisplay file last access time.
-a, --attributesWin Display file attributes (HSRALCE). See additional info below.
-vi, --version-infoWin Displays VersionInfo block from executable files, if available.
-u, --summaryShow summary: the number of files found, their total size, elapsed time.
-of, --out-format=s|l|f 142 | Output format: s, l, f
143 |   s | Simple - only file names (default)
144 |   l | Long - file names with additional information.
145 |       Alias for: -n -S -dw -a -u.
146 |   f | Full - displays full information.
147 |       Alias for: -n -s -S -dc -dw -da -a -vi -u. 148 |
-l, --longLong format. Alias for --out-format=long
-sl, --list-separator=STRList separator. Default: " | "
-sdt, --dt-separator=STRDate-time separator. Default: " - "
-err, --show-errors=1|0Display errors. 1 - enabled, 0 - disabled. Default: 1
173 | 174 |
175 |

File attributes Win

176 | 177 | 178 | 179 | 180 | 181 | 182 | 183 | 184 | 185 | 186 | 187 | 188 | 189 | 190 | 191 |
H - hiddenS - systemR - read only
A - archiveL - symbolic linkC - compressed
E - encrypted
192 | 193 |
194 | 195 | 196 | 197 | 198 | 199 | 200 | 201 |

Sorting

202 | 203 | 204 | 205 | 206 | 207 | 208 | 217 | 218 | 219 | 220 | 221 | 226 | 227 | 228 | 229 |
SwitchDescription
-sb, --sort-by=[COL] 209 | Sort results by specified column. Available values:
210 |   name - Sort results by file name. Default.
211 |   size - Sort results by file size.
212 |   dc - Win Sort results by file creation date.
213 |   dw - Sort results by file last write date.
214 |   da - Sort results by file last access date.
215 |   none - Do not sort results. 216 |
-sd, --sort-direction=a|d 222 | Sorting order. The -sb switch should be specified. Available values:
223 |   a | Ascending - Sort results in ascending order. Default.
224 |   d | Descending - Sort results in descending order. 225 |
230 | 231 | 232 | 233 | 234 | 235 |

Highlighting

236 | 237 | 238 | 239 | 240 | 241 | 242 | 243 | 244 | 245 | 246 | 247 | 248 | 249 | 250 | 251 | 252 | 253 | 254 | 255 | 256 | 257 | 258 | 259 | 260 | 261 | 262 | 263 | 264 | 265 | 266 | 267 | 268 | 269 | 270 | 271 | 272 | 273 | 274 | 275 | 276 | 277 | 278 | 279 | 280 | 281 | 282 | 283 | 284 | 285 | 286 | 287 | 288 | 289 | 290 | 291 | 292 | 293 | 294 | 295 | 296 | 297 | 298 |
SwitchDescription
-hus, --highlight-str=STRHighlight string specified by the user.
-hus2, --highlight-str2=STRHighlight string specified by the user.
-husc, --highlight-str-cs=[1|0]Take into account (or not) the character size when highlighting the text provided by the user. 1 - enabled, 0 - disabled. Default: 0
-hn, --highlight-noneDon't highlight any files.
-he, --highlight-exe=1|0Win Highlight executable files - EXE. 1 - enabled, 0 - disabled. Default: 1
-hd, --highlight-dll=1|0Win Highlight DLL libraries. 1 - enabled, 0 - disabled. Default: 1
-hb, --highlight-bat=1|0Win Highlight batch scripts - BAT. 1 - enabled, 0 - disabled. Default: 1
-hc, --highlight-cmd=1|0Win Highlight CMD scripts. 1 - enabled, 0 - disabled. Default: 1
-hp, --highlight-bpl=1|0Win Highlight BPL libraries. 1 - enabled, 0 - disabled. Default: 1
-hs, --highlight-sh=1|0Lin Highlight shell scripts - SH. 1 - enabled, 0 - disabled. Default: 1
-hl, --highlight-so=1|0Lin Highlight SO libraries. 1 - enabled, 0 - disabled. Default: 1
299 | 300 | 301 | 302 | 303 |

Checksum & hash

304 | 305 | 306 | 307 | 308 | 309 | 310 | 311 | 312 | 313 | 314 | 315 | 316 | 317 | 318 | 319 | 320 | 321 | 322 | 323 | 324 | 325 | 326 | 327 | 328 | 329 |
SwitchDescription
--crcCalculate CRC32 checksums of found files.
--md5Calculate MD5 hash of found files.
--sha1Calculate SHA-1 hash of found files.
--sha2Calculate SHA-2-256 hash of found files.
330 | 331 | 332 | 333 | 334 | 335 |

Information

336 | 337 | 338 | 339 | 340 | 341 | 342 | 343 | 344 | 345 | 346 | 347 | 348 | 349 | 350 | 351 | 352 | 353 | 354 | 355 | 356 | 357 | 358 | 359 | 360 | 361 | 362 | 363 | 364 | 365 | 366 | 367 |
SwitchDescription
-h, --helpDisplay help.
-hh, --help-onlineWin Opens program help page in the default browser.
-V, --versionShow application name and version.
-vs, --version-shortShow only the version number and exit.
--homeWin Opens program homepage in the default browser.
368 | 369 |
370 | 371 | 372 | 373 | 374 |

375 | 376 | 377 |

Exit codes

378 | 379 | 380 | 381 | 382 | 383 | 384 | 385 | 386 | 387 | 388 | 389 | 390 | 391 | 392 | 393 | 394 | 395 | 396 | 397 | 398 | 399 |
Exit codeDescription
0Success.
1Invalid syntax or other error.
2No files found.
400 | 401 | 402 | 403 |
404 | 405 | 406 | 407 | 410 | 411 | 412 | 413 | -------------------------------------------------------------------------------- /htmlhelp/html/version.html: -------------------------------------------------------------------------------- 1 |  2 | 3 | 4 | 5 | Version info - PathLocate 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 |

Version information

16 | 17 |
18 | 19 | 20 | 21 | 22 | 23 |
24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | 52 | 53 | 54 | 55 | 56 | 57 | 58 | 59 | 60 | 61 | 62 | 63 | 64 | 65 | 66 | 67 | 68 | 69 | 70 | 71 | 76 | 77 | 78 | 79 | 80 |
Program namePathLocate
Program version1.1
Release date2018.03.19
LicenseFree, Open-Source
System 49 | Windows XP or newer
50 | Linux 51 |
AuthorJacek Pazera
Home pagehttp://www.pazera-software.com/products/path-locate
Help onlinehttp://www.pazera-software.com/products/path-locate/help.html
Additional information 72 | 73 |
The help file and this page were created using the Precision Helper application available at www.be-precision.com/products/precision-helper/
74 | 75 |
81 | 82 | 83 |
84 | 85 | 86 | 87 | 90 | 91 | 92 | 93 | -------------------------------------------------------------------------------- /htmlhelp/open_with_ms-hhw.bat: -------------------------------------------------------------------------------- 1 | @echo off 2 | 3 | set hhw=E:\Programs\HTML Help Workshop\hhw.exe 4 | 5 | "%hhw%" PathLocate.hhp -------------------------------------------------------------------------------- /src/Info.txt: -------------------------------------------------------------------------------- 1 | 2 | CodeTyphon 6.40 3 | FPC 3.1.1 4 | 5 | ---------------------------------------------------------- 6 | 7 | Changes 8 | 9 | 1.0 -> 1.1 10 | 11 | CodeTyphon 6.30 -> 6.40 12 | + Zastosowanie klasy TApp: TJPConsoleApp 13 | + Hasze: MD5, SHA-1, SHA-2-256 14 | - CRT - zbyt duże ograniczenia. Usunięte! 15 | + Obsługa kolorów za pomocą modułu JPL.Console i JPL.Console.ColorParser 16 | + Podświetlanie kilku typów plików (EXE, DLL, BAT, CMD, BPL, SH, SO) 17 | + Podświetlanie tekstu podanego przez uzytkownika: -hus, -hus2 18 | + Sprawdzanie, czy urządzenie wyjściowe jest "urządzeniem znakowym" (konsola, terminal, drukarka). 19 | Jeśli tak, stosuję ANSI Escape Codes, w przeciwnym razie kody ANSI nie będą używane. 20 | Dzięki temu strumień danych wyjściowych przekierowany do pliku/potoku nie będzie "zaśmiecony" kodami ANSI. 21 | + Sortowanie: -sb, -sd 22 | + Listowanie katalogów z %PATH%: -ld 23 | + Long format switch: -l, --long 24 | + Separator elementów listy oraz daty i czasu: -sl, -sdt 25 | + Show errors: -err 26 | + Daty: access, creation: -da, -dc 27 | + Attributes: -a 28 | + Short version info: -vs 29 | 30 | -------------------------------- 31 | 32 | Releases 33 | 34 | 1.0 - 2018.01.25 35 | 1.1 - 2018.03.19 36 | 37 | 38 | ---------------------------------------------------------- 39 | 40 | Linux terminal 41 | 42 | Używać: 43 | pathlocate "*" 44 | NIE 45 | pathlocate * 46 | 47 | Sama * jest zamieniana automatycznie przez system na listę plików z bieżącego katalogu! 48 | 49 | ---------------------------------------------------- 50 | 51 | DO ZROBIENIA 52 | 53 | 1. Wyszukiwanie plików zawierających podany tekst w VersionInfo. 54 | 2. Limit rozmiaru: 55 | -sm, --size-min 56 | -sx, --size-max 57 | 3. Obsługa wyrażeń regularnych (TRegExp A. Sorokina). 58 | 4. DONE: Możliwość ustawienia separatora danych przez użytkownika, co pozwoli na przekierowanie wyjścia np. do pliku CSV. 59 | 5. Filtrowanie plików wg dat podanych przez użytkownika. 60 | 6. Kopiowanie wyjścia do schowka, tylko bez stosowania modułu "clipbrd" (rozmiar EXE Win 64-bit pow. 1.1 MB). 61 | 7. Odczyt poleceń z plików. -i, --input-file 62 | 63 | 64 | ------------------------------------------------------- 65 | 66 | JUŻ NIEAKTUALNE! 67 | 68 | //CRT 69 | //Gdy ustawiona jest dyrektywa kompilatora USE_COLORS (*CRT build modes), stosowany jest moduł Crt, który narzuca poważne ograniczenia, 70 | //m.in. nie pozwala przekierować StdOut do pliku, brak kodowania UTF-8 w konsoli/termianlu, wyświetlanie dużej ilości plików trwa BARDZO wolno. 71 | //Szczegóły: https://www.freepascal.org/docs-html/rtl/crt/index.html 72 | -------------------------------------------------------------------------------- /src/PLOC.PROCS.pas: -------------------------------------------------------------------------------- 1 | unit PLOC.PROCS; 2 | 3 | { 4 | Jacek Pazera 5 | http://www.pazera-software.com 6 | Last mod: 2018.03.19 7 | } 8 | 9 | {$mode objfpc}{$H+} 10 | 11 | interface 12 | 13 | uses 14 | // FPC units 15 | SysUtils, DateUtils, 16 | MFPC.Classes.SHARED, 17 | 18 | // App units 19 | PLOC.Types, 20 | 21 | // JPLib / JPLib (M) units 22 | JPL.Console, 23 | JPL.StrList, JPL.Strings, JPL.CmdLineParser, JPL.DateTime, JPLM.Files, 24 | JPLM.FileSearch, JPL.SimpleLogger, 25 | 26 | // Hash 27 | JPLM.Hash.Common, 28 | JPLM.Hash.CRC32, JPLM.Hash.WE_MD5, JPLM.Hash.WE_SHA1, JPLM.Hash.WE_SHA2_256 29 | 30 | // Windows only 31 | {$IFDEF MSWINDOWS}, Windows, JPL.Win.VersionInfo {$ENDIF} 32 | 33 | ; 34 | 35 | 36 | function GetOutputLine(const FileInfo: TFileExtInfo; const FileNo: integer; PadSizeMax: Integer; const dp: TDisplayParams; out bError: Boolean; 37 | Logger: TJPSimpleLogger = nil): string; 38 | 39 | {$IFDEF MSWINDOWS} 40 | function GetVersionInfoStr(const FileName: string): string; 41 | function WinDir: string; 42 | {$ENDIF} 43 | 44 | function IsExeFile(const FileName: string): Boolean; 45 | function IsDllFile(const FileName: string): Boolean; 46 | function IsBatFile(const FileName: string): Boolean; 47 | function IsCmdFile(const FileName: string): Boolean; 48 | function IsBplFile(const FileName: string): Boolean; 49 | function IsShellScriptFile(const FileName: string): Boolean; 50 | function IsSoLibFile(const FileName: string): Boolean; 51 | 52 | function TryGetLimitValue(s: string; out LM: TLimitMode; out xFiles: integer; out sErr: string): Boolean; 53 | function TryGetSortDirectionValue(s: string; out SortMode: TSortDirection): Boolean; 54 | function TryGetSortByFieldValue(s: string; out sbf: TSortByField): Boolean; 55 | 56 | procedure StrToList(LineToParse: string; var List: TJPStrList; Separator: string = ','); 57 | 58 | procedure GetFilesExtInfo(sl: TJPStrList; var Arr: TFileInfoArray; bOnlyNameAndSize: Boolean); 59 | function GetMaxFileSize(Arr: TFileInfoArray): Int64; 60 | 61 | procedure WriteColoredTextLine(const s: string; const ccNormal, ccError: TConsoleColors; bError: Boolean); 62 | 63 | procedure SortFileInfoArray(var Arr: TFileInfoArray; sbf: TSortByField; const bAscending: Boolean); 64 | 65 | 66 | 67 | 68 | implementation 69 | 70 | 71 | 72 | procedure WriteColoredTextLine(const s: string; const ccNormal, ccError: TConsoleColors; bError: Boolean); 73 | begin 74 | if bError then TConsole.WriteColoredTextLine(s, ccError) // ConWriteColoredTextLine(s, ccError) 75 | else 76 | if (ccNormal.Text = TConsole.clNone) and (ccNormal.Background = TConsole.clNone) then Writeln(s) 77 | else TConsole.WriteColoredTextLine(s, ccNormal); // ConWriteColoredTextLine(s, ccNormal); 78 | end; 79 | 80 | {$IFDEF MSWINDOWS} 81 | function WinDir: string; 82 | var 83 | Buffer: array[0..MAX_PATH - 1] of Char; 84 | begin 85 | FillChar(Buffer, SizeOf(Buffer), 0); 86 | GetWindowsDirectory(Buffer, SizeOf(Buffer)); 87 | Result := Buffer; 88 | end; 89 | {$ENDIF} 90 | 91 | procedure StrToList(LineToParse: string; var List: TJPStrList; Separator: string = ','); 92 | var 93 | xp: integer; 94 | s: string; 95 | begin 96 | 97 | xp := Pos(Separator, LineToParse); 98 | while xp > 0 do 99 | begin 100 | s := Trim(Copy(LineToParse, 1, xp - 1)); 101 | List.Add(s); 102 | Delete(LineToParse, 1, xp + Length(Separator) - 1); 103 | LineToParse := Trim(LineToParse); 104 | xp := Pos(Separator, LineToParse); 105 | end; 106 | 107 | if LineToParse <> '' then 108 | begin 109 | LineToParse := Trim(LineToParse); 110 | if LineToParse <> '' then List.Add(LineToParse); 111 | end; 112 | 113 | end; 114 | 115 | 116 | {$region ' Sorting '} 117 | 118 | procedure _ExchangeItems(var Arr: TFileInfoArray; const Index1, Index2: integer); 119 | var 120 | Temp: TFileExtInfo; 121 | begin 122 | Temp := Arr[Index1]; 123 | Arr[Index1] := Arr[Index2]; 124 | Arr[Index2] := Temp; 125 | end; 126 | 127 | function _CompareFunc(const fei1, fei2: TFileExtInfo; const sbf: TSortByField; const bAscending: Boolean): integer; 128 | begin 129 | case sbf of 130 | 131 | sbfSize: 132 | begin 133 | if fei1.Size < fei2.Size then Result := -1 134 | else if fei1.Size = fei2.Size then Result := 0 135 | else Result := 1; 136 | end; 137 | 138 | sbfDateCreation: Result := CompareDateTime(fei1.Dates.Creation, fei2.Dates.Creation); 139 | sbfDateLastWrite: Result := CompareDateTime(fei1.Dates.LastWrite, fei2.Dates.LastWrite); 140 | sbfDateLastAccess: Result := CompareDateTime(fei1.Dates.LastAccess, fei2.Dates.LastAccess); 141 | 142 | else 143 | Result := 0; 144 | end; 145 | 146 | if not bAscending then Result := -Result; 147 | end; 148 | 149 | 150 | procedure _SortFEIArray(var Arr: TFileInfoArray; LeftIndex, RightIndex: Integer; CompareProc: TSortFIACompareFunc; const sbf: TSortByField; const bAscending: Boolean); 151 | var 152 | I, J, PivotIndex: Integer; 153 | begin 154 | repeat 155 | 156 | I := LeftIndex; 157 | J := RightIndex; 158 | PivotIndex := (LeftIndex + RightIndex) shr 1; 159 | 160 | repeat 161 | 162 | while _CompareFunc(Arr[I], Arr[PivotIndex], sbf, bAscending) < 0 do Inc(I); 163 | while _CompareFunc(Arr[J], Arr[PivotIndex], sbf, bAscending) > 0 do Dec(J); 164 | 165 | if I <= J then 166 | begin 167 | if I <> J then _ExchangeItems(Arr, I, J); 168 | 169 | if PivotIndex = I then PivotIndex := J 170 | else if PivotIndex = J then PivotIndex := I; 171 | Inc(I); 172 | Dec(J); 173 | end; 174 | 175 | until I > J; 176 | 177 | if LeftIndex < J then _SortFEIArray(Arr, LeftIndex, J, CompareProc, sbf, bAscending); 178 | LeftIndex := I; 179 | 180 | until I >= RightIndex; 181 | end; 182 | 183 | procedure SortFileInfoArray(var Arr: TFileInfoArray; sbf: TSortByField; const bAscending: Boolean); 184 | begin 185 | if Length(Arr) < 2 then Exit; 186 | _SortFEIArray(Arr, 0, High(Arr), @_CompareFunc, sbf, bAscending); 187 | end; 188 | 189 | 190 | function TryGetSortDirectionValue(s: string; out SortMode: TSortDirection): Boolean; 191 | begin 192 | Result := True; 193 | s := TrimUp(s); 194 | 195 | if {(s = '') or} (s = 'A') or (s = 'ASCENDING') then SortMode := TSortDirection.sdAscending 196 | else if (s = 'D') or (s = 'DESCENDING') then SortMode := TSortDirection.sdDescending 197 | else Result := False; 198 | end; 199 | 200 | function TryGetSortByFieldValue(s: string; out sbf: TSortByField): Boolean; 201 | begin 202 | Result := True; 203 | s := TrimUp(s); 204 | case s of 205 | 'NAME': sbf := sbfFileName; 206 | 'SIZE': sbf := sbfSize; 207 | {$IFDEF MSWINDOWS}'DC': sbf := sbfDateCreation;{$ENDIF} 208 | 'DW': sbf := sbfDateLastWrite; 209 | 'DA': sbf := sbfDateLastAccess; 210 | 'NONE': sbf := sbfNone; 211 | else 212 | Result := False; 213 | end; 214 | end; 215 | 216 | {$endregion Sorting} 217 | 218 | 219 | procedure GetFilesExtInfo(sl: TJPStrList; var Arr: TFileInfoArray; bOnlyNameAndSize: Boolean); 220 | var 221 | i: integer; 222 | fName: string; 223 | fei: TFileExtInfo; 224 | fir: TFileInfoRec; 225 | bOK: Boolean; 226 | begin 227 | for i := 0 to sl.Count - 1 do 228 | begin 229 | 230 | fName := sl[i]; 231 | fei.FileName := fName; 232 | 233 | bOK := GetFileInfoRec(fName, fir, bOnlyNameAndSize); 234 | if not bOK then fei.Size := FileSizeInt(fName) 235 | else fei.Size := fir.Size; 236 | 237 | if not bOnlyNameAndSize then 238 | begin 239 | 240 | {$IFDEF MSWINDOWS} 241 | fei.Dates.Creation := fir.CreationTime; 242 | if fir.AttrsOK then fei.Attrs := fir.FileAttrs.Attrs 243 | else fei.Attrs := -1; 244 | {$ENDIF} 245 | fei.Dates.LastWrite := fir.LastWriteTime; 246 | fei.Dates.LastAccess := fir.LastAccessTime; 247 | end; 248 | 249 | SetLength(Arr, Length(Arr) + 1); 250 | Arr[High(Arr)] := fei; 251 | 252 | end; 253 | end; 254 | 255 | function GetMaxFileSize(Arr: TFileInfoArray): Int64; 256 | var 257 | MaxSize: Int64; 258 | i: integer; 259 | begin 260 | MaxSize := 0; 261 | for i := 0 to High(Arr) do 262 | if Arr[i].Size > MaxSize then MaxSize := Arr[i].Size; 263 | Result := MaxSize; 264 | end; 265 | 266 | 267 | 268 | {$region ' GetOutputLine '} 269 | function GetOutputLine(const FileInfo: TFileExtInfo; const FileNo: integer; PadSizeMax: Integer; const dp: TDisplayParams; out bError: Boolean; 270 | Logger: TJPSimpleLogger): string; 271 | var 272 | dwCrc32: DWORD; 273 | FileName, sErr, sNum, sSizeBytes, sSizeHuman, sDateCreation, sDateWrite, sDateAccess, sAttrs, Sep, SepDT, sCrc, sMd5, sSha1, sSha2: string; 274 | hrr: THashResultRec; 275 | xPadSizeLong: integer; 276 | clErr1, clErr2: string; 277 | 278 | function _GetDateStr(const dt: TDateTime): string; 279 | begin 280 | if dt <> 0 then Result := GetDateTimeStr(dt, '$Y-$M-$D' + SepDT + '$H:$MIN:$S') + Sep 281 | else Result := 'xxxx-xx-xx' + SepDT + 'xx:xx:xx' + Sep; 282 | end; 283 | 284 | procedure _LogE(const Text, Context: string); 285 | begin 286 | if Assigned(Logger) then Logger.LogError(Text, Context); 287 | end; 288 | 289 | begin 290 | FileName := FileInfo.FileName; 291 | Sep := dp.Separator; 292 | SepDT := dp.Separator_DateTime; 293 | xPadSizeLong := 10; 294 | bError := False; 295 | clErr1 := 'magenta'; 296 | clErr2 := 'yellow'; 297 | 298 | //------------------------------------------------------- 299 | if dp.Numbering then sNum := Pad(IntToStrEx(FileNo), 3, ' ') + '.' + Sep else sNum := ''; 300 | 301 | //------------------------------------------------------- 302 | if dp.Hash_Crc then 303 | begin 304 | dwCrc32 := CalcFileCRC32(FileName, nil, True); 305 | if dwCrc32 = 0 then 306 | begin 307 | sCrc := StringOfChar('-', HASH_LEN_CRC32) + Sep; 308 | bError := True; 309 | _LogE('Cannot calculate the CRC32 cheksum of the file: "' + FileName + '"', 'CRC32'); 310 | end 311 | else sCrc := IntToHex(dwCrc32, 8) + Sep; 312 | end 313 | else sCrc := ''; 314 | 315 | //------------------------------------------------------- 316 | sMd5 := ''; 317 | if dp.Hash_MD5 then 318 | begin 319 | sErr := StringOfChar('-', HASH_LEN_MD5) + Sep; 320 | try 321 | if WeGetFileHash_Md5(FileName, hrr, nil) then sMd5 := hrr.StrValueUpper + Sep 322 | else sMd5 := sErr; 323 | except 324 | on E: EFopenError do sMd5 := sErr; 325 | end; 326 | if sMd5 = sErr then 327 | begin 328 | bError := True; 329 | _LogE('Cannot calculate the MD5 hash of the file: "' + FileName + '"', 'MD5'); 330 | end; 331 | end; 332 | 333 | //------------------------------------------------------- 334 | sSha1 := ''; 335 | if dp.Hash_SHA1 then 336 | begin 337 | sErr := StringOfChar('-', HASH_LEN_SHA1) + Sep; 338 | try 339 | if WeGetFileHash_Sha1(FileName, hrr, nil) then sSha1 := hrr.StrValueUpper + Sep 340 | else sSha1 := sErr; 341 | except 342 | on E: EFopenError do sSha1 := sErr; 343 | end; 344 | if sSha1 = sErr then 345 | begin 346 | bError := True; 347 | _LogE('Cannot calculate the SHA-1 hash of the file: "' + FileName + '"', 'SHA-1'); 348 | end; 349 | end; 350 | 351 | //------------------------------------------------------- 352 | sSha2 := ''; 353 | if dp.Hash_SHA2 then 354 | begin 355 | sErr := StringOfChar('-', HASH_LEN_SHA2_256) + Sep; 356 | try 357 | if WeGetFileHash_SHA2_256(FileName, hrr, nil) then sSha2 := hrr.StrValueUpper + Sep 358 | else sSha2 := sErr; 359 | except 360 | on E: EFopenError do sSha2 := sErr; 361 | end; 362 | if sSha2 = sErr then 363 | begin 364 | bError := True; 365 | _LogE('Cannot calculate the SHA-2 hash of the file: "' + FileName + '"', 'SHA-2'); 366 | end; 367 | end; 368 | 369 | //------------------------------------------------------- 370 | sSizeBytes := ''; 371 | if dp.SizeBytes then 372 | if FileInfo.Size >= 0 then sSizeBytes := Pad(IntToStrEx(FileInfo.Size), PadSizeMax, ' ') + Sep 373 | else 374 | begin 375 | sSizeBytes := Pad('-', PadSizeMax, ' ') + Sep; 376 | bError := True; 377 | end; 378 | 379 | //------------------------------------------------------- 380 | sSizeHuman := ''; 381 | if dp.SizeHuman then 382 | if FileInfo.Size >= 0 then sSizeHuman := Pad(GetFileSizeString(FileInfo.Size, ' B'), xPadSizeLong, ' ') + Sep 383 | else 384 | begin 385 | sSizeHuman := Pad('-', xPadSizeLong, ' ') + Sep; 386 | bError := True; 387 | end; 388 | 389 | 390 | if ( (dp.SizeBytes) or (dp.SizeHuman) ) and (FileInfo.Size < 0) then 391 | _LogE('Cannot read size of the file: "' + FileName + '"', 'FileSize'); 392 | 393 | 394 | //------------------------------------------------------- 395 | sDateCreation := ''; 396 | {$IFDEF MSWINDOWS} 397 | if dp.Date_Creation then 398 | begin 399 | sDateCreation := _GetDateStr(FileInfo.Dates.Creation); 400 | if FileInfo.Dates.Creation = 0 then 401 | begin 402 | bError := True; 403 | _LogE('Cannot read creation date of the file: "' + FileName + '"', 'C-Date'); 404 | end; 405 | end; 406 | {$ENDIF} 407 | 408 | sDateWrite := ''; 409 | if dp.Date_LastWrite then 410 | begin 411 | sDateWrite := _GetDateStr(FileInfo.Dates.LastWrite); 412 | if FileInfo.Dates.LastWrite = 0 then 413 | begin 414 | bError := True; 415 | _LogE('Cannot read last write date of the file: "' + FileName + '"', 'LW-Date'); 416 | end; 417 | end; 418 | 419 | sDateAccess := ''; 420 | if dp.Date_LastAccess then 421 | begin 422 | sDateAccess := _GetDateStr(FileInfo.Dates.LastAccess); 423 | if FileInfo.Dates.LastAccess = 0 then 424 | begin 425 | bError := True; 426 | _LogE('Cannot read last access date of the file: "' + FileName + '"', 'LA-Date'); 427 | end; 428 | end; 429 | 430 | //------------------------------------------------------- 431 | sAttrs := ''; 432 | {$IFDEF MSWINDOWS} 433 | if dp.FileAttributes then 434 | if FileInfo.Attrs >= 0 then sAttrs := FileAttributesToStr(FileInfo.Attrs, '-', True) + Sep 435 | else 436 | begin 437 | sAttrs := StringOfChar('-', 7) + Sep; 438 | bError := True; 439 | _LogE('Cannot read attributes of the file: "' + FileName + '"', 'Attrs'); 440 | end; 441 | {$ENDIF} 442 | 443 | 444 | 445 | Result := sNum + sSizeBytes + sSizeHuman + sDateCreation + sDateWrite + sDateAccess + sAttrs + sCrc + sMd5 + sSha1 + sSha2 + FileName; 446 | 447 | end; 448 | {$endregion GetOutputLine} 449 | 450 | 451 | 452 | {$region ' TryGetLimitValue '} 453 | // No RegEx, only Pos, Copy, etc. 454 | function TryGetLimitValue(s: string; out LM: TLimitMode; out xFiles: integer; out sErr: string): Boolean; 455 | var 456 | xd: integer; 457 | sName, sVal: string; 458 | begin 459 | Result := False; 460 | sErr := ''; 461 | 462 | s := TrimUp(s); 463 | 464 | 465 | // First X files (1) 466 | if TryStrToInt(s, xFiles) then 467 | begin 468 | if xFiles < 0 then 469 | begin 470 | sErr := 'The number of files must be non-negative integer.'; 471 | Exit; 472 | end 473 | else 474 | begin 475 | Result := True; 476 | LM := lmFirst; 477 | Exit; 478 | end; 479 | end; 480 | 481 | 482 | // no limit 483 | if (s = 'N') or (s = 'NONE') then 484 | begin 485 | Result := True; 486 | xFiles := 0; 487 | LM := lmNoLimit; 488 | Exit; 489 | end; 490 | 491 | 492 | // First X files (2) 493 | if (Copy(s, 1, 5) = 'FIRST') or (Copy(s, 1, 1) = 'F') then 494 | begin 495 | 496 | xd := GetFirstDigitIndex(s); 497 | if xd = 0 then Exit; 498 | sName := Trim(Copy(s, 1, xd - 1)); 499 | sVal := Trim(Copy(s, xd, Length(s))); 500 | if (sName <> 'F') and (sName <> 'FIRST') then Exit; 501 | 502 | if TryStrToInt(sVal, xFiles) then 503 | begin 504 | if xFiles <= 0 then 505 | begin 506 | sErr := 'The number of files must be non-negative integer.'; 507 | Exit; 508 | end 509 | else 510 | begin 511 | Result := True; 512 | LM := lmFirst; 513 | Exit; 514 | end; 515 | end 516 | else 517 | begin 518 | sErr := 'Invalid or too large number: ' + sVal; 519 | Exit; 520 | end; 521 | 522 | end; 523 | 524 | 525 | // Last X files (2) 526 | if (Copy(s, 1, 5) = 'LAST') or (Copy(s, 1, 1) = 'L') then 527 | begin 528 | 529 | xd := GetFirstDigitIndex(s); 530 | if xd = 0 then Exit; 531 | sName := Trim(Copy(s, 1, xd - 1)); 532 | sVal := Trim(Copy(s, xd, Length(s))); 533 | if (sName <> 'L') and (sName <> 'LAST') then Exit; 534 | 535 | if TryStrToInt(sVal, xFiles) then 536 | begin 537 | if xFiles <= 0 then 538 | begin 539 | sErr := 'The number of files must be non-negative integer.'; 540 | Exit; 541 | end 542 | else 543 | begin 544 | Result := True; 545 | LM := lmLast; 546 | Exit; 547 | end; 548 | end 549 | else 550 | begin 551 | sErr := 'Invalid or too large number: ' + sVal; 552 | Exit; 553 | end; 554 | 555 | end; 556 | 557 | end; 558 | 559 | {$endregion TryGetLimitValue} 560 | 561 | 562 | {$IFDEF MSWINDOWS} 563 | function GetVersionInfoStr(const FileName: string): string; 564 | const 565 | ExeExts: array [0..13] of string = ('EXE', 'DLL', 'BPL', 'OCX', 'TLB', 'SYS', 'CPL', 'SCR', 'RS', 'RLL', 'MUI', 'DRV', 'AX', 'ACM'); 566 | var 567 | i, xInd: integer; 568 | Ext: string; 569 | vi: TJPVersionInfo; 570 | sii: TVIStringInfoItem; 571 | begin 572 | Result := ''; 573 | 574 | Ext := UpperCase(GetFileExt(FileName, True)); 575 | for i := 0 to High(ExeExts) do 576 | 577 | if Ext = ExeExts[i] then 578 | begin 579 | 580 | vi := TJPVersionInfo.Create(FileName); 581 | try 582 | if not vi.ValidVersionInfo then Exit; 583 | if vi.StringItemsCount = 0 then Exit; 584 | if vi.EnglishStringItemIndex >= 0 then xInd := vi.EnglishStringItemIndex else xInd := 0; 585 | sii := vi.StringItems[xInd]; 586 | Result := VIStringInfoItemToStr(sii, False, False, ' '); 587 | finally 588 | vi.Free; 589 | end; 590 | 591 | Break; 592 | end; 593 | 594 | end; 595 | {$ENDIF} 596 | 597 | function IsExeFile(const FileName: string): Boolean; 598 | begin 599 | Result := UpperCase(GetFileExt(FileName, True)) = 'EXE'; 600 | end; 601 | 602 | function IsDllFile(const FileName: string): Boolean; 603 | begin 604 | Result := UpperCase(GetFileExt(FileName, True)) = 'DLL'; 605 | end; 606 | 607 | function IsBatFile(const FileName: string): Boolean; 608 | begin 609 | Result := UpperCase(GetFileExt(FileName, True)) = 'BAT'; 610 | end; 611 | 612 | function IsCmdFile(const FileName: string): Boolean; 613 | begin 614 | Result := UpperCase(GetFileExt(FileName, True)) = 'CMD'; 615 | end; 616 | 617 | function IsBplFile(const FileName: string): Boolean; 618 | begin 619 | Result := UpperCase(GetFileExt(FileName, True)) = 'BPL'; 620 | end; 621 | 622 | function IsShellScriptFile(const FileName: string): Boolean; 623 | begin 624 | Result := UpperCase(GetFileExt(FileName, True)) = 'SH'; 625 | end; 626 | 627 | function IsSoLibFile(const FileName: string): Boolean; 628 | begin 629 | Result := UpperCase(GetFileExt(FileName, True)) = 'SO'; 630 | end; 631 | 632 | 633 | 634 | 635 | 636 | 637 | 638 | 639 | end. 640 | 641 | -------------------------------------------------------------------------------- /src/PLOC.Types.pas: -------------------------------------------------------------------------------- 1 | unit PLOC.Types; 2 | 3 | { 4 | Jacek Pazera 5 | http://www.pazera-software.com 6 | Last mod: 2018.03.19 7 | } 8 | 9 | {$mode objfpc}{$H+} 10 | 11 | interface 12 | 13 | uses 14 | JPL.StrList, JPLM.Files, JPL.Console 15 | ; 16 | 17 | 18 | const 19 | 20 | {$IFDEF MSWINDOWS} 21 | PATH_VAR = '%PATH%'; 22 | PATH_SEPARATOR = ';'; 23 | {$ELSE} 24 | PATH_VAR = '$PATH'; 25 | PATH_SEPARATOR = ':'; 26 | {$ENDIF} 27 | 28 | DASH_LINE = '--------------------------------------------------------------------------------'; 29 | 30 | BOOL_STR_TRUE = '1'; 31 | BOOL_STR_FALSE = '0'; 32 | 33 | 34 | EXIT_OK = JPL.Console.CON_EXIT_CODE_OK; 35 | EXIT_ERROR = JPL.Console.CON_EXIT_CODE_ERROR; 36 | EXIT_NO_FILES = 2; 37 | 38 | 39 | {$IFDEF MSWINDOWS} 40 | COLOR_EXE_TEXT = TConsole.clLightGreenText; 41 | COLOR_EXE_BG = TConsole.clNone; 42 | 43 | COLOR_DLL_TEXT = TConsole.clLightCyanText; 44 | COLOR_DLL_BG = TConsole.clNone; 45 | 46 | COLOR_BAT_TEXT = TConsole.clLightYellowText; 47 | COLOR_BAT_BG = TConsole.clNone; 48 | 49 | COLOR_CMD_TEXT = TConsole.clDarkYellowText; 50 | COLOR_CMD_BG = TConsole.clNone; 51 | 52 | COLOR_BPL_TEXT = TConsole.clWhiteText; 53 | COLOR_BPL_BG = TConsole.clDarkGrayText; 54 | 55 | {$ELSE} 56 | 57 | COLOR_SH_TEXT = TConsole.clLightYellowText; 58 | COLOR_SH_BG = TConsole.clNone; 59 | 60 | COLOR_SO_TEXT = TConsole.clLightCyanText; 61 | COLOR_SO_BG = TConsole.clNone; 62 | 63 | {$ENDIF} 64 | 65 | COLOR_HIGHLIGHT_FG1 = TConsole.clWhiteText; 66 | COLOR_HIGHLIGHT_BG1 = TConsole.clLightBlueBg; 67 | 68 | COLOR_HIGHLIGHT_FG2 = TConsole.clBlackText; 69 | COLOR_HIGHLIGHT_BG2 = TConsole.clLightGreenBg; 70 | 71 | type 72 | 73 | TFileExtInfo = record 74 | FileName: string; 75 | Dates: TFileDates; 76 | Attrs: LongInt; 77 | Size: Int64; 78 | end; 79 | 80 | 81 | TDisplayParams = record 82 | Separator: string; 83 | Separator_DateTime: string; 84 | Numbering: Boolean; 85 | SizeBytes: Boolean; 86 | SizeHuman: Boolean; 87 | FileAttributes: Boolean; 88 | Date_Creation: Boolean; 89 | Date_LastWrite: Boolean; 90 | Date_LastAccess: Boolean; 91 | Hash_Crc: Boolean; 92 | Hash_MD5: Boolean; 93 | Hash_SHA1: Boolean; 94 | Hash_SHA2: Boolean; 95 | end; 96 | 97 | TFileInfoArray = array of TFileExtInfo; 98 | 99 | TLimitMode = (lmNoLimit, lmFirst, lmLast); // All files / fisrt X files / last X files 100 | 101 | TSortDirection = (sdAscending, sdDescending); 102 | TSortByField = (sbfNone, sbfFileName, sbfSize, sbfDateCreation, sbfDateLastWrite, sbfDateLastAccess); 103 | TSortFIACompareFunc = function (const fei1, fei2: TFileExtInfo; const sbf: TSortByField; const bAscending: Boolean): integer; 104 | 105 | 106 | TAppParams = record 107 | FileMasks: TJPStrList; // -f 108 | Dirs: TJPStrList; // -p 109 | SizeBytes: Boolean; // -s 110 | SizeHuman: Boolean; // -S 111 | {$IFDEF MSWINDOWS} 112 | DateCreation: Boolean; // -dc 113 | FileAttrs: Boolean; // -a 114 | {$ENDIF} 115 | DateLastWrite: Boolean; // -dw 116 | DateLastAccess: Boolean; // -da 117 | Numbering: Boolean; // -n 118 | CaseSensitive: Boolean; // -cs 119 | AlsoCurrentDir: Boolean; // -c 120 | ShowSummary: Boolean; // -u 121 | CalcCrc32: Boolean; // --crc 122 | CalcHashMD5: Boolean; // --md5 123 | CalcHashSha1: Boolean; // --sha1 124 | CalcHashSha2_256: Boolean; // --sha2 125 | LimitMode: TLimitMode; // -lm 126 | FileCountLimit: integer; // -lm firstX | lastX 127 | SortDirection: TSortDirection; // -sd 128 | SortByField: TSortByField; // -sb 129 | ListDirs: Boolean; // -ld 130 | ListSeparator: string; // -sl - list items separator 131 | DateTimeSeparator: string; // -sdt - date / time separator 132 | DisplayErrors: Boolean; // -err 133 | {$IFDEF MSWINDOWS} 134 | ReadVersionInfo: Boolean; // -vi 135 | {$ENDIF} 136 | 137 | HighlightErrors: Boolean; 138 | ConColor_Error: TConsoleColors; 139 | UserHighlightStr1: string; // -hus : highlight string specified by the user 140 | UserHighlightStr2: string; // -hus2 : highlight string specified by the user 141 | UserHighlightCaseSensitive: Boolean; // -husc 142 | ConColor_USER_1: TConsoleColors; // używane przy podświetlaniu tekstu podanego przez użytkownika 143 | ConColor_USER_2: TConsoleColors; // używane przy podświetlaniu tekstu podanego przez użytkownika 144 | 145 | {$IFDEF MSWINDOWS} 146 | HighlightExes: Boolean; // -he 147 | HighlightDlls: Boolean; // -hd 148 | HighlightBats: Boolean; // -hb 149 | HighlightCmds: Boolean; // -hc 150 | HighlightBpls: Boolean; // -hp 151 | 152 | ConColor_EXE: TConsoleColors; 153 | ConColor_DLL: TConsoleColors; 154 | ConColor_BAT: TConsoleColors; 155 | ConColor_CMD: TConsoleColors; 156 | ConColor_BPL: TConsoleColors; 157 | {$ELSE} // Linux 158 | HighlightBashScripts: Boolean; // -hs 159 | HighlightSoLibs: Boolean; // -hl 160 | 161 | ConColor_SH: TConsoleColors; 162 | ConColor_SO: TConsoleColors; 163 | {$ENDIF} 164 | end; 165 | 166 | implementation 167 | 168 | end. 169 | 170 | -------------------------------------------------------------------------------- /src/PathLocate.ctpr: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | <UseAppBundle Value="False"/> 16 | <ResourceType Value="res"/> 17 | </General> 18 | <VersionInfo> 19 | <UseVersionInfo Value="True"/> 20 | <MajorVersionNr Value="1"/> 21 | <MinorVersionNr Value="1"/> 22 | <StringTable Comments="http://www.pazera-software.com" CompanyName="Jacek Pazera" FileDescription="PathLocate" InternalName="PathLocate" LegalCopyright="Jacek Pazera" LegalTrademarks="Jacek Pazera" OriginalFilename="pathlocate" ProductName="PathLocate" ProductVersion="1.1"/> 23 | </VersionInfo> 24 | <BuildModes Count="6"> 25 | <Item1 Name="Debug Win32" Default="True"/> 26 | <Item2 Name="Release Win32"> 27 | <CompilerOptions> 28 | <Version Value="11"/> 29 | <PathDelim Value="\"/> 30 | <Target> 31 | <Filename Value="..\PathLocate32"/> 32 | </Target> 33 | <SearchPaths> 34 | <IncludeFiles Value="$(ProjOutDir);we;$(TyphonDir)\components\BaseUtils"/> 35 | <OtherUnitFiles Value="we"/> 36 | <UnitOutputDirectory Value="..\lib\$(TargetCPU)-$(TargetOS)"/> 37 | </SearchPaths> 38 | <CodeGeneration> 39 | <SmartLinkUnit Value="True"/> 40 | <TargetCPU Value="i386"/> 41 | <TargetOS Value="win32"/> 42 | <Optimizations> 43 | <OptimizationLevel Value="3"/> 44 | </Optimizations> 45 | </CodeGeneration> 46 | <Linking> 47 | <Debugging> 48 | <GenerateDebugInfo Value="False"/> 49 | </Debugging> 50 | <LinkSmart Value="True"/> 51 | </Linking> 52 | <Other> 53 | <CompilerMessages> 54 | <IgnoredMessages idx6058="True" idx3124="True" idx3123="True"/> 55 | </CompilerMessages> 56 | </Other> 57 | </CompilerOptions> 58 | </Item2> 59 | <Item3 Name="Release Win64"> 60 | <CompilerOptions> 61 | <Version Value="11"/> 62 | <PathDelim Value="\"/> 63 | <Target> 64 | <Filename Value="..\PathLocate64"/> 65 | </Target> 66 | <SearchPaths> 67 | <IncludeFiles Value="$(ProjOutDir);we;$(TyphonDir)\components\BaseUtils"/> 68 | <OtherUnitFiles Value="we"/> 69 | <UnitOutputDirectory Value="..\lib\$(TargetCPU)-$(TargetOS)"/> 70 | </SearchPaths> 71 | <CodeGeneration> 72 | <SmartLinkUnit Value="True"/> 73 | <TargetCPU Value="x86_64"/> 74 | <TargetOS Value="win64"/> 75 | <Optimizations> 76 | <OptimizationLevel Value="3"/> 77 | </Optimizations> 78 | </CodeGeneration> 79 | <Linking> 80 | <Debugging> 81 | <GenerateDebugInfo Value="False"/> 82 | </Debugging> 83 | <LinkSmart Value="True"/> 84 | </Linking> 85 | <Other> 86 | <CompilerMessages> 87 | <IgnoredMessages idx6058="True" idx3124="True" idx3123="True"/> 88 | </CompilerMessages> 89 | </Other> 90 | </CompilerOptions> 91 | </Item3> 92 | <Item4 Name="Release Lin32"> 93 | <CompilerOptions> 94 | <Version Value="11"/> 95 | <PathDelim Value="\"/> 96 | <Target> 97 | <Filename Value="..\pathlocate32"/> 98 | </Target> 99 | <SearchPaths> 100 | <IncludeFiles Value="$(ProjOutDir);we;$(TyphonDir)\components\BaseUtils"/> 101 | <OtherUnitFiles Value="we"/> 102 | <UnitOutputDirectory Value="..\lib\$(TargetCPU)-$(TargetOS)"/> 103 | </SearchPaths> 104 | <CodeGeneration> 105 | <SmartLinkUnit Value="True"/> 106 | <TargetCPU Value="i386"/> 107 | <TargetOS Value="linux"/> 108 | <Optimizations> 109 | <OptimizationLevel Value="3"/> 110 | </Optimizations> 111 | </CodeGeneration> 112 | <Linking> 113 | <Debugging> 114 | <GenerateDebugInfo Value="False"/> 115 | </Debugging> 116 | <LinkSmart Value="True"/> 117 | </Linking> 118 | <Other> 119 | <CompilerMessages> 120 | <IgnoredMessages idx6058="True" idx3124="True" idx3123="True"/> 121 | </CompilerMessages> 122 | </Other> 123 | </CompilerOptions> 124 | </Item4> 125 | <Item5 Name="Release Lin64"> 126 | <CompilerOptions> 127 | <Version Value="11"/> 128 | <PathDelim Value="\"/> 129 | <Target> 130 | <Filename Value="..\pathlocate64"/> 131 | </Target> 132 | <SearchPaths> 133 | <IncludeFiles Value="$(ProjOutDir);we;$(TyphonDir)\components\BaseUtils"/> 134 | <OtherUnitFiles Value="we"/> 135 | <UnitOutputDirectory Value="..\lib\$(TargetCPU)-$(TargetOS)"/> 136 | </SearchPaths> 137 | <CodeGeneration> 138 | <SmartLinkUnit Value="True"/> 139 | <TargetCPU Value="x86_64"/> 140 | <TargetOS Value="linux"/> 141 | <Optimizations> 142 | <OptimizationLevel Value="3"/> 143 | </Optimizations> 144 | </CodeGeneration> 145 | <Linking> 146 | <Debugging> 147 | <GenerateDebugInfo Value="False"/> 148 | </Debugging> 149 | <LinkSmart Value="True"/> 150 | </Linking> 151 | <Other> 152 | <CompilerMessages> 153 | <IgnoredMessages idx6058="True" idx3124="True" idx3123="True"/> 154 | </CompilerMessages> 155 | </Other> 156 | </CompilerOptions> 157 | </Item5> 158 | <Item6 Name="Debug Lin64"> 159 | <CompilerOptions> 160 | <Version Value="11"/> 161 | <PathDelim Value="\"/> 162 | <Target> 163 | <Filename Value="..\pathlocate_debug_L64"/> 164 | </Target> 165 | <SearchPaths> 166 | <IncludeFiles Value="$(ProjOutDir);we;$(TyphonDir)\components\BaseUtils"/> 167 | <OtherUnitFiles Value="we"/> 168 | <UnitOutputDirectory Value="..\lib\$(TargetCPU)-$(TargetOS)_debug"/> 169 | </SearchPaths> 170 | <Parsing> 171 | <SyntaxOptions> 172 | <IncludeAssertionCode Value="True"/> 173 | </SyntaxOptions> 174 | </Parsing> 175 | <CodeGeneration> 176 | <Checks> 177 | <IOChecks Value="True"/> 178 | <RangeChecks Value="True"/> 179 | <OverflowChecks Value="True"/> 180 | <StackChecks Value="True"/> 181 | </Checks> 182 | <VerifyObjMethodCallValidity Value="True"/> 183 | <TargetCPU Value="x86_64"/> 184 | <TargetOS Value="linux"/> 185 | </CodeGeneration> 186 | <Linking> 187 | <Debugging> 188 | <GenerateDebugInfo Value="False"/> 189 | <DebugInfoType Value="dsDwarf2Set"/> 190 | <UseHeaptrc Value="True"/> 191 | <TrashVariables Value="True"/> 192 | <UseExternalDbgSyms Value="True"/> 193 | </Debugging> 194 | </Linking> 195 | <Other> 196 | <CompilerMessages> 197 | <IgnoredMessages idx6058="True" idx3124="True" idx3123="True"/> 198 | </CompilerMessages> 199 | </Other> 200 | </CompilerOptions> 201 | </Item6> 202 | </BuildModes> 203 | <PublishOptions> 204 | <Version Value="2"/> 205 | </PublishOptions> 206 | <RunParams> 207 | <FormatVersion Value="2"/> 208 | <Modes Count="1"> 209 | <Mode0 Name="default"/> 210 | </Modes> 211 | </RunParams> 212 | <RequiredPackages Count="1"> 213 | <Item1> 214 | <PackageName Value="adFCL"/> 215 | </Item1> 216 | </RequiredPackages> 217 | <Units Count="5"> 218 | <Unit0> 219 | <Filename Value="PathLocate.ppr"/> 220 | <IsPartOfProject Value="True"/> 221 | </Unit0> 222 | <Unit1> 223 | <Filename Value="PLOC.App.pas"/> 224 | <IsPartOfProject Value="True"/> 225 | </Unit1> 226 | <Unit2> 227 | <Filename Value="PLOC.Types.pas"/> 228 | <IsPartOfProject Value="True"/> 229 | </Unit2> 230 | <Unit3> 231 | <Filename Value="PLOC.PROCS.pas"/> 232 | <IsPartOfProject Value="True"/> 233 | </Unit3> 234 | <Unit4> 235 | <Filename Value="Info.txt"/> 236 | <IsPartOfProject Value="True"/> 237 | </Unit4> 238 | </Units> 239 | </ProjectOptions> 240 | <CompilerOptions> 241 | <Version Value="11"/> 242 | <PathDelim Value="\"/> 243 | <Target> 244 | <Filename Value="..\PathLocate_debug"/> 245 | </Target> 246 | <SearchPaths> 247 | <IncludeFiles Value="$(ProjOutDir);we;$(TyphonDir)\components\BaseUtils"/> 248 | <OtherUnitFiles Value="we"/> 249 | <UnitOutputDirectory Value="..\lib\$(TargetCPU)-$(TargetOS)_debug"/> 250 | </SearchPaths> 251 | <Parsing> 252 | <SyntaxOptions> 253 | <IncludeAssertionCode Value="True"/> 254 | </SyntaxOptions> 255 | </Parsing> 256 | <CodeGeneration> 257 | <Checks> 258 | <IOChecks Value="True"/> 259 | <RangeChecks Value="True"/> 260 | <OverflowChecks Value="True"/> 261 | <StackChecks Value="True"/> 262 | </Checks> 263 | <VerifyObjMethodCallValidity Value="True"/> 264 | <TargetCPU Value="i386"/> 265 | <TargetOS Value="win32"/> 266 | </CodeGeneration> 267 | <Linking> 268 | <Debugging> 269 | <GenerateDebugInfo Value="False"/> 270 | <DebugInfoType Value="dsDwarf2Set"/> 271 | <UseHeaptrc Value="True"/> 272 | <TrashVariables Value="True"/> 273 | <UseExternalDbgSyms Value="True"/> 274 | </Debugging> 275 | </Linking> 276 | <Other> 277 | <CompilerMessages> 278 | <IgnoredMessages idx6058="True" idx3124="True" idx3123="True"/> 279 | </CompilerMessages> 280 | </Other> 281 | </CompilerOptions> 282 | <Debugging> 283 | <Exceptions Count="3"> 284 | <Item1> 285 | <Name Value="EAbort"/> 286 | </Item1> 287 | <Item2> 288 | <Name Value="ECodetoolError"/> 289 | </Item2> 290 | <Item3> 291 | <Name Value="EFOpenError"/> 292 | </Item3> 293 | </Exceptions> 294 | </Debugging> 295 | </CONFIG> 296 | -------------------------------------------------------------------------------- /src/PathLocate.ppr: -------------------------------------------------------------------------------- 1 | program PathLocate; 2 | 3 | { 4 | Jacek Pazera 5 | http://www.pazera-software.com 6 | Last mod: 2018.03.19 7 | } 8 | 9 | {$mode objfpc}{$H+} 10 | 11 | {$IFDEF MSWINDOWS} 12 | {$APPTYPE CONSOLE} 13 | {$SetPEFlags $20} // IMAGE_FILE_LARGE_ADDRESS_AWARE 14 | {$ENDIF} 15 | 16 | 17 | {$R *.res} 18 | 19 | uses 20 | {$IFDEF UNIX}{$IFDEF UseCThreads} cthreads, {$ENDIF}{$ENDIF} 21 | SysUtils, 22 | PLOC.App, 23 | PLOC.Types, 24 | PLOC.PROCS 25 | ; 26 | 27 | 28 | var 29 | App: TApp; 30 | 31 | {$IFDEF MSWINDOWS} 32 | // Na Linuxie czasami wyskakuje EAccessViolation 33 | procedure MyExitProcedure; 34 | begin 35 | if Assigned(App) then 36 | begin 37 | App.Done; 38 | FreeAndNil(App); 39 | end; 40 | end; 41 | {$ENDIF} 42 | 43 | 44 | begin 45 | 46 | App := TApp.Create; 47 | try 48 | 49 | try 50 | 51 | {$IFDEF MSWINDOWS}App.ExitProcedure := @MyExitProcedure;{$ENDIF} 52 | App.Init; 53 | App.Run; 54 | if Assigned(App) then App.Done; 55 | 56 | except 57 | on E: Exception do Writeln(E.ClassName, ': ', E.Message); 58 | end; 59 | 60 | finally 61 | if Assigned(App) then App.Free; 62 | end; 63 | 64 | end. 65 | -------------------------------------------------------------------------------- /src/PathLocate.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jackdp/PathLocate/68e633e9d859ea1f64848ec5bda26ebefe48dde2/src/PathLocate.res -------------------------------------------------------------------------------- /src/we/Readme.md: -------------------------------------------------------------------------------- 1 | In this directory there are several Wolfgang Ehrhardt's hashing units for Pascal used by [PathLocate](https://github.com/jackdp/PathLocate). 2 | 3 | On Wolfgang's site you can find many interesting units, mainly related to mathematics, hashing and cryptography: http://www.wolfgang-ehrhardt.de/index.html -------------------------------------------------------------------------------- /src/we/btypes.pas: -------------------------------------------------------------------------------- 1 | unit BTypes; 2 | 3 | {Common basic type definitions} 4 | 5 | 6 | interface 7 | 8 | 9 | {$i STD.INC} 10 | 11 | (************************************************************************* 12 | 13 | DESCRIPTION : Common basic type definitions 14 | 15 | REQUIREMENTS : TP5-7, D1-D7/D9-D12/D17-D22, FPC, VP, WDOSX 16 | 17 | EXTERNAL DATA : --- 18 | 19 | MEMORY USAGE : --- 20 | 21 | DISPLAY MODE : --- 22 | 23 | REFERENCES : --- 24 | 25 | 26 | Version Date Author Modification 27 | ------- -------- ------- ------------------------------------------ 28 | 0.10 15.04.06 W.Ehrhardt Initial version 29 | 0.11 15.04.06 we With $ifdef HAS_XTYPES 30 | 0.12 15.04.06 we FPC1_0 and pShortInt 31 | 0.13 09.09.08 we UInt32 = cardinal $ifdef HAS_CARD32 32 | 0.14 12.11.08 we Str127, Ptr2Inc 33 | 0.15 14.11.08 we BString, char8 34 | 0.16 21.11.08 we __P2I: type cast pointer to integer for masking etc 35 | 0.17 02.12.08 we Use pchar and pAnsiChar for pchar8 if possible 36 | 0.18 27.02.09 we pBoolean 37 | 0.19 14.02.12 we extended = double $ifdef SIMULATE_EXT64 38 | 0.20 06.05.14 we extended = double $ifdef SIMULATE_EXT64 OR EXT64 39 | 0.21 25.04.15 we With $ifdef HAS_INTXX, HAS_PINTXX 40 | *************************************************************************) 41 | 42 | 43 | (*------------------------------------------------------------------------- 44 | (C) Copyright 2006-2015 Wolfgang Ehrhardt 45 | 46 | This software is provided 'as-is', without any express or implied warranty. 47 | In no event will the authors be held liable for any damages arising from 48 | the use of this software. 49 | 50 | Permission is granted to anyone to use this software for any purpose, 51 | including commercial applications, and to alter it and redistribute it 52 | freely, subject to the following restrictions: 53 | 54 | 1. The origin of this software must not be misrepresented; you must not 55 | claim that you wrote the original software. If you use this software in 56 | a product, an acknowledgment in the product documentation would be 57 | appreciated but is not required. 58 | 59 | 2. Altered source versions must be plainly marked as such, and must not be 60 | misrepresented as being the original software. 61 | 62 | 3. This notice may not be removed or altered from any source distribution. 63 | ----------------------------------------------------------------------------*) 64 | 65 | {$ifdef BIT16} 66 | type 67 | Int8 = ShortInt; { 8 bit signed integer} 68 | Int16 = Integer; {16 bit signed integer} 69 | Int32 = Longint; {32 bit signed integer} 70 | UInt8 = Byte; { 8 bit unsigned integer} 71 | UInt16 = Word; {16 bit unsigned integer} 72 | UInt32 = Longint; {32 bit unsigned integer} 73 | 74 | Smallint = Integer; 75 | Shortstring = string; 76 | 77 | pByte = ^Byte; 78 | pBoolean = ^Boolean; 79 | pShortInt = ^ShortInt; 80 | pWord = ^Word; 81 | pSmallInt = ^SmallInt; 82 | pLongint = ^Longint; 83 | 84 | {$else} 85 | 86 | {$ifndef HAS_INTXX} 87 | type 88 | Int8 = ShortInt; { 8 bit signed integer} 89 | Int16 = SmallInt; {16 bit signed integer} 90 | Int32 = Longint; {32 bit signed integer} 91 | UInt8 = Byte; { 8 bit unsigned integer} 92 | UInt16 = Word; {16 bit unsigned integer} 93 | {$ifdef HAS_CARD32} 94 | UInt32 = Cardinal; {32 bit unsigned integer} 95 | {$else} 96 | UInt32 = Longint; {32 bit unsigned integer} 97 | {$endif} 98 | {$endif} 99 | 100 | {$ifndef HAS_XTYPES} 101 | type 102 | pByte = ^Byte; 103 | pBoolean = ^Boolean; 104 | pShortInt = ^ShortInt; 105 | pWord = ^Word; 106 | pSmallInt = ^SmallInt; 107 | pLongint = ^Longint; 108 | {$endif} 109 | {$ifdef FPC} {$ifdef VER1_0} 110 | type 111 | pBoolean = ^Boolean; 112 | pShortInt = ^ShortInt; 113 | {$endif} {$endif} 114 | 115 | {$endif} {BIT16} 116 | 117 | type 118 | Str255 = string[255]; {Handy type to avoid problems with 32 bit and/or unicode} 119 | Str127 = string[127]; 120 | 121 | type 122 | {$ifndef HAS_PINTXX} 123 | pInt8 = ^Int8; 124 | pInt16 = ^Int16; 125 | pInt32 = ^Int32; 126 | pUInt8 = ^UInt8; 127 | pUInt16 = ^UInt16; 128 | pUInt32 = ^UInt32; 129 | {$endif} 130 | pStr255 = ^Str255; 131 | pStr127 = ^Str127; 132 | 133 | {$ifdef BIT16} 134 | {$ifdef V7Plus} 135 | type 136 | BString = string[255]; {String of 8 bit characters} 137 | pBString = ^BString; 138 | char8 = char; {8 bit characters} 139 | pchar8 = pchar; 140 | {$else} 141 | type 142 | BString = string[255]; {String of 8 bit characters} 143 | pBString = ^BString; 144 | char8 = char; {8 bit characters} 145 | pchar8 = ^char; 146 | {$endif} 147 | {$else} 148 | {$ifdef UNICODE} 149 | type 150 | BString = AnsiString; {String of 8 bit characters} 151 | pBString = pAnsiString; 152 | char8 = AnsiChar; {8 bit characters} 153 | pchar8 = pAnsiChar; 154 | {$else} 155 | type 156 | BString = AnsiString; {String of 8 bit characters} 157 | pBString = pAnsiString; 158 | char8 = AnsiChar; {8 bit characters} 159 | pchar8 = pAnsiChar; 160 | {$endif} 161 | {$endif} 162 | 163 | 164 | {$ifdef V7Plus} 165 | type 166 | Ptr2Inc = pByte; {Type cast to increment untyped pointer} 167 | {$else} 168 | type 169 | Ptr2Inc = Longint; {Type cast to increment untyped pointer} 170 | {$endif} 171 | 172 | 173 | {$ifdef FPC} 174 | {$ifdef VER1} 175 | type __P2I = longint; {Type cast pointer to integer for masking etc} 176 | {$else} 177 | type __P2I = PtrUInt; {Type cast pointer to integer for masking etc} 178 | {$endif} 179 | {$else} 180 | {$ifdef BIT64} 181 | type __P2I = NativeInt; {Type cast pointer to integer for masking etc} 182 | {$else} 183 | type __P2I = longint; {Type cast pointer to integer for masking etc} 184 | {$endif} 185 | {$endif} 186 | 187 | 188 | {$ifdef EXT64} 189 | type extended = double; {Force 64-bit 'extended'} 190 | {$else} 191 | {$ifdef SIMULATE_EXT64} 192 | type extended = double; {Debug simulation EXT64} 193 | {$endif} 194 | {$endif} 195 | 196 | 197 | implementation 198 | 199 | end. 200 | -------------------------------------------------------------------------------- /src/we/hash.pas: -------------------------------------------------------------------------------- 1 | unit Hash; 2 | 3 | {General Hash Unit: This unit defines the common types, functions, and 4 | procedures. Via Hash descriptors and corresponding pointers, algorithms 5 | can be searched by name or by ID. More important: all supported algorithms 6 | can be used in the HMAC and KDF constructions.} 7 | 8 | 9 | interface 10 | 11 | (************************************************************************* 12 | 13 | DESCRIPTION : General hash unit: defines Algo IDs, digest types, etc 14 | 15 | REQUIREMENTS : TP5-7, D1-D7/D9-D10/D12/D17-D18/D25S, FPC, VP 16 | 17 | EXTERNAL DATA : --- 18 | 19 | MEMORY USAGE : --- 20 | 21 | DISPLAY MODE : --- 22 | 23 | REFERENCES : --- 24 | 25 | REMARK : THashContext does not directly map the structure of the 26 | context for SHA3 algorithms, a typecast with TSHA3State 27 | from unit SHA3 should be used to access the fields. 28 | 29 | 30 | Version Date Author Modification 31 | ------- -------- ------- ------------------------------------------ 32 | 0.10 15.01.06 W.Ehrhardt Initial version 33 | 0.11 15.01.06 we FindHash_by_ID, $ifdef DLL: stdcall 34 | 0.12 16.01.06 we FindHash_by_Name 35 | 0.13 18.01.06 we Descriptor fields HAlgNum, HSig 36 | 0.14 22.01.06 we Removed HSelfTest from descriptor 37 | 0.14 31.01.06 we RIPEMD-160, C_MinHash, C_MaxHash 38 | 0.15 11.02.06 we Fields: HDSize, HVersion, HPtrOID, HLenOID 39 | 0.16 02.08.06 we Packed arrays 40 | 0.17 07.08.06 we $ifdef BIT32: (const fname: shortstring...) 41 | 0.18 07.08.06 we C_HashVers = $00010002 42 | 0.19 10.02.07 we HashFile: no eof, XL and filemode via $ifdef 43 | 0.20 18.02.07 we MD4, C_HashVers = $00010003 44 | 0.21 22.02.07 we POID_Vec=^TOID_Vec, typed HPtrOID 45 | 0.22 24.02.07 we added some checks for HSig=C_HashSig 46 | 0.23 04.10.07 we THashContext.Index now longint 47 | 0.24 02.05.08 we type PHashDigest, function HashSameDigest 48 | 0.25 04.05.08 we BitAPI_Mask, BitAPI_PBit 49 | 0.26 05.05.08 we Descriptor with HFinalBit, C_HashVers=$00010004 50 | 0.27 20.05.08 we RMD160 as alias for RIPEMD160 51 | 0.28 12.11.08 we uses BTypes and Str255 52 | 0.29 19.07.09 we D12 fix: assign with typecast string(fname) 53 | 0.30 08.03.12 we SHA512/224 and SHA512/256, C_HashVers=$00010005 54 | 0.31 10.03.12 we HashFile: {$ifndef BIT16} instead of {$ifdef WIN32} 55 | 56 | 0.32 08.08.18 we New enlarged padded context, _SHA3_224 .. _SHA3_512 57 | 0.33 08.08.18 we THMacBuffer, assert HASHCTXSIZE 58 | 0.34 16.08.15 we Removed $ifdef DLL / stdcall 59 | 60 | 0.35 15.05.17 we Changes for Blake2s 61 | 0.36 16.05.17 we MaxOIDLen = 11 and MaxC_HashVers = $00020002 62 | 63 | 0.37 03.11.17 we TBlake2B_384/512Digest 64 | 65 | **************************************************************************) 66 | 67 | (*------------------------------------------------------------------------- 68 | (C) Copyright 2006-2015 Wolfgang Ehrhardt 69 | 70 | This software is provided 'as-is', without any express or implied warranty. 71 | In no event will the authors be held liable for any damages arising from 72 | the use of this software. 73 | 74 | Permission is granted to anyone to use this software for any purpose, 75 | including commercial applications, and to alter it and redistribute it 76 | freely, subject to the following restrictions: 77 | 78 | 1. The origin of this software must not be misrepresented; you must not 79 | claim that you wrote the original software. If you use this software in 80 | a product, an acknowledgment in the product documentation would be 81 | appreciated but is not required. 82 | 83 | 2. Altered source versions must be plainly marked as such, and must not be 84 | misrepresented as being the original software. 85 | 86 | 3. This notice may not be removed or altered from any source distribution. 87 | ----------------------------------------------------------------------------*) 88 | 89 | {$i STD.INC} 90 | 91 | uses 92 | BTypes; 93 | 94 | type 95 | THashAlgorithm = (_MD4, _MD5, _RIPEMD160, _SHA1, 96 | _SHA224, _SHA256, _SHA384, _SHA512, 97 | _Whirlpool, _SHA512_224, _SHA512_256, 98 | _SHA3_224, _SHA3_256, _SHA3_384, _SHA3_512, 99 | _Blake2S_224, _Blake2S_256, 100 | _Blake2B_384, _Blake2B_512); {Supported hash algorithms} 101 | 102 | const 103 | _RMD160 = _RIPEMD160; {Alias} 104 | 105 | const 106 | MaxBlockLen = 128; {Max. block length (buffer size), multiple of 4} 107 | MaxDigestLen = 64; {Max. length of hash digest} 108 | MaxStateLen = 16; {Max. size of internal state} 109 | MaxOIDLen = 11; {Current max. OID length} 110 | C_HashSig = $3D7A; {Signature for Hash descriptor} 111 | C_HashVers = $00020002; {Version of Hash definitions} 112 | C_MinHash = _MD4; {Lowest hash in THashAlgorithm} 113 | C_MaxHash = _Blake2B_512;{Highest hash in THashAlgorithm} 114 | 115 | type 116 | THashState = packed array[0..MaxStateLen-1] of longint; {Internal state} 117 | THashBuffer = packed array[0..MaxBlockLen-1] of byte; {hash buffer block} 118 | THashDigest = packed array[0..MaxDigestLen-1] of byte; {hash digest} 119 | PHashDigest = ^THashDigest; {pointer to hash digest} 120 | THashBuf32 = packed array[0..MaxBlockLen div 4 -1] of longint; {type cast helper} 121 | THashDig32 = packed array[0..MaxDigestLen div 4 -1] of longint; {type cast helper} 122 | THMacBuffer = packed array[0..143] of byte; {hmac buffer block} 123 | 124 | const 125 | HASHCTXSIZE = 448; {Common size of enlarged padded old context} 126 | {and new padded SHA3/SHAKE/Keccak context } 127 | 128 | type 129 | THashContext = packed record 130 | Hash : THashState; {Working hash} 131 | MLen : packed array[0..3] of longint; {max 128 bit msg length} 132 | Buffer: THashBuffer; {Block buffer} 133 | Index : longint; {Index in buffer} 134 | Fill2 : packed array[213..HASHCTXSIZE] of byte; 135 | end; 136 | 137 | type 138 | TMD4Digest = packed array[0..15] of byte; {MD4 digest } 139 | TMD5Digest = packed array[0..15] of byte; {MD5 digest } 140 | TRMD160Digest = packed array[0..19] of byte; {RMD160 digest } 141 | TSHA1Digest = packed array[0..19] of byte; {SHA1 digest } 142 | TSHA224Digest = packed array[0..27] of byte; {SHA224 digest } 143 | TSHA256Digest = packed array[0..31] of byte; {SHA256 digest } 144 | TSHA384Digest = packed array[0..47] of byte; {SHA384 digest } 145 | TSHA512Digest = packed array[0..63] of byte; {SHA512 digest } 146 | TSHA5_224Digest = packed array[0..27] of byte; {SHA512/224 digest} 147 | TSHA5_256Digest = packed array[0..31] of byte; {SHA512/256 digest} 148 | TWhirlDigest = packed array[0..63] of byte; {Whirlpool digest } 149 | TSHA3_224Digest = packed array[0..27] of byte; {SHA3_224 digest } 150 | TSHA3_256Digest = packed array[0..31] of byte; {SHA3_256 digest } 151 | TSHA3_384Digest = packed array[0..47] of byte; {SHA3_384 digest } 152 | TSHA3_512Digest = packed array[0..63] of byte; {SHA3_512 digest } 153 | TBlake2S_224Digest = packed array[0..27] of byte; {Blake2S digest } 154 | TBlake2S_256Digest = packed array[0..31] of byte; {Blake2S digest } 155 | TBlake2B_384Digest = packed array[0..47] of byte; {Blake2B-384 digest} 156 | TBlake2B_512Digest = packed array[0..63] of byte; {Blake2B-512 digest} 157 | 158 | 159 | type 160 | HashInitProc = procedure(var Context: THashContext); 161 | {-initialize context} 162 | 163 | HashUpdateXLProc = procedure(var Context: THashContext; Msg: pointer; Len: longint); 164 | {-update context with Msg data} 165 | 166 | HashFinalProc = procedure(var Context: THashContext; var Digest: THashDigest); 167 | {-finalize calculation, clear context} 168 | 169 | HashFinalBitProc = procedure(var Context: THashContext; var Digest: THashDigest; BData: byte; bitlen: integer); 170 | {-finalize calculation with bitlen bits from BData, clear context} 171 | 172 | type 173 | TOID_Vec = packed array[1..MaxOIDLen] of longint; {OID vector} 174 | POID_Vec = ^TOID_Vec; {ptr to OID vector} 175 | 176 | type 177 | THashName = string[19]; {Hash algo name type } 178 | PHashDesc = ^THashDesc; {Ptr to descriptor } 179 | THashDesc = packed record 180 | HSig : word; {Signature=C_HashSig } 181 | HDSize : word; {sizeof(THashDesc) } 182 | HDVersion : longint; {THashDesc Version } 183 | HBlockLen : word; {Blocklength of hash, rate div 8 for SHA3} 184 | HDigestlen: word; {Digestlength of hash} 185 | HInit : HashInitProc; {Init procedure } 186 | HFinal : HashFinalProc; {Final procedure } 187 | HUpdateXL : HashUpdateXLProc; {Update procedure } 188 | HAlgNum : longint; {Algo ID, longint avoids problems with enum size/DLL} 189 | HName : THashName; {Name of hash algo } 190 | HPtrOID : POID_Vec; {Pointer to OID vec } 191 | HLenOID : word; {Length of OID vec } 192 | HFill : word; 193 | HFinalBit : HashFinalBitProc; {Bit-API Final proc } 194 | HReserved : packed array[0..19] of byte; 195 | end; 196 | 197 | 198 | const 199 | BitAPI_Mask: array[0..7] of byte = ($00,$80,$C0,$E0,$F0,$F8,$FC,$FE); 200 | BitAPI_PBit: array[0..7] of byte = ($80,$40,$20,$10,$08,$04,$02,$01); 201 | 202 | procedure RegisterHash(AlgId: THashAlgorithm; PHash: PHashDesc); 203 | {-Register algorithm with AlgID and Hash descriptor PHash^} 204 | 205 | function FindHash_by_ID(AlgoID: THashAlgorithm): PHashDesc; 206 | {-Return PHashDesc of AlgoID, nil if not found/registered} 207 | 208 | function FindHash_by_Name(AlgoName: THashName): PHashDesc; 209 | {-Return PHashDesc of Algo with AlgoName, nil if not found/registered} 210 | 211 | procedure HashFile({$ifdef CONST} const {$endif} fname: Str255; PHash: PHashDesc; 212 | var Digest: THashDigest; var buf; bsize: word; var Err: word); 213 | {-Calulate hash digest of file, buf: buffer with at least bsize bytes} 214 | 215 | procedure HashUpdate(PHash: PHashDesc; var Context: THashContext; Msg: pointer; Len: word); 216 | {-update context with Msg data} 217 | 218 | procedure HashFullXL(PHash: PHashDesc; var Digest: THashDigest; Msg: pointer; Len: longint); 219 | {-Calulate hash digest of Msg with init/update/final} 220 | 221 | procedure HashFull(PHash: PHashDesc; var Digest: THashDigest; Msg: pointer; Len: word); 222 | {-Calulate hash digest of Msg with init/update/final} 223 | 224 | function HashSameDigest(PHash: PHashDesc; PD1, PD2: PHashDigest): boolean; 225 | {-Return true if same digests, using HDigestlen of PHash} 226 | 227 | 228 | implementation 229 | 230 | 231 | var 232 | PHashVec : array[THashAlgorithm] of PHashDesc; 233 | {Hash descriptor pointers of all defined hash algorithms} 234 | 235 | {---------------------------------------------------------------------------} 236 | procedure RegisterHash(AlgId: THashAlgorithm; PHash: PHashDesc); 237 | {-Register algorithm with AlgID and Hash descriptor PHash^} 238 | begin 239 | if (PHash<>nil) and 240 | (PHash^.HAlgNum=longint(AlgId)) and 241 | (PHash^.HSig=C_HashSig) and 242 | (PHash^.HDVersion=C_HashVers) and 243 | (PHash^.HDSize=sizeof(THashDesc)) then PHashVec[AlgId] := PHash; 244 | end; 245 | 246 | 247 | {---------------------------------------------------------------------------} 248 | function FindHash_by_ID(AlgoID: THashAlgorithm): PHashDesc; 249 | {-Return PHashDesc of AlgoID, nil if not found/registered} 250 | var 251 | p: PHashDesc; 252 | A: longint; 253 | begin 254 | A := longint(AlgoID); 255 | FindHash_by_ID := nil; 256 | if (A>=ord(C_MinHash)) and (A<=ord(C_MaxHash)) then begin 257 | p := PHashVec[AlgoID]; 258 | if (p<>nil) and (p^.HSig=C_HashSig) and (p^.HAlgNum=A) then FindHash_by_ID := p; 259 | end; 260 | end; 261 | 262 | 263 | {---------------------------------------------------------------------------} 264 | function FindHash_by_Name(AlgoName: THashName): PHashDesc; 265 | {-Return PHashDesc of Algo with AlgoName, nil if not found/registered} 266 | var 267 | algo : THashAlgorithm; 268 | phash: PHashDesc; 269 | 270 | function StrUpcase(s: THashName): THashName; 271 | {-Upcase for strings} 272 | var 273 | i: integer; 274 | begin 275 | for i:=1 to length(s) do s[i] := upcase(s[i]); 276 | StrUpcase := s; 277 | end; 278 | 279 | begin 280 | AlgoName := StrUpcase(Algoname); 281 | {Transform RMD160 alias to standard name} 282 | if AlgoName='RMD160' then AlgoName:='RIPEMD160'; 283 | FindHash_by_Name := nil; 284 | for algo := C_MinHash to C_MaxHash do begin 285 | phash := PHashVec[algo]; 286 | if (phash<>nil) and (AlgoName=StrUpcase(phash^.HName)) 287 | and (phash^.HSig=C_HashSig) and (phash^.HAlgNum=longint(algo)) 288 | then begin 289 | FindHash_by_Name := phash; 290 | exit; 291 | end; 292 | end; 293 | end; 294 | 295 | 296 | {---------------------------------------------------------------------------} 297 | procedure HashUpdate(PHash: PHashDesc; var Context: THashContext; Msg: pointer; Len: word); 298 | {-update context with Msg data} 299 | begin 300 | if PHash<>nil then with PHash^ do begin 301 | if HSig=C_HashSig then HUpdateXL(Context, Msg, Len); 302 | end; 303 | end; 304 | 305 | 306 | {---------------------------------------------------------------------------} 307 | procedure HashFullXL(PHash: PHashDesc; var Digest: THashDigest; Msg: pointer; Len: longint); 308 | {-Calulate hash digest of Msg with init/update/final} 309 | var 310 | Context: THashContext; 311 | begin 312 | if PHash<>nil then with PHash^ do begin 313 | if HSig=C_HashSig then begin 314 | HInit(Context); 315 | HUpdateXL(Context, Msg, Len); 316 | HFinal(Context, Digest); 317 | end; 318 | end; 319 | end; 320 | 321 | 322 | {---------------------------------------------------------------------------} 323 | procedure HashFull(PHash: PHashDesc; var Digest: THashDigest; Msg: pointer; Len: word); 324 | {-Calulate hash digest of Msg with init/update/final} 325 | begin 326 | {test PHash<>nil in HashFullXL} 327 | HashFullXL(PHash, Digest, Msg, Len); 328 | end; 329 | 330 | 331 | {---------------------------------------------------------------------------} 332 | function HashSameDigest(PHash: PHashDesc; PD1, PD2: PHashDigest): boolean; 333 | {-Return true if same digests, using HDigestlen of PHash} 334 | var 335 | i: integer; 336 | begin 337 | HashSameDigest := false; 338 | if PHash<>nil then with PHash^ do begin 339 | if (HSig=C_HashSig) and (HDigestlen>0) then begin 340 | for i:=0 to pred(HDigestlen) do begin 341 | if PD1^[i]<>PD2^[i] then exit; 342 | end; 343 | HashSameDigest := true; 344 | end; 345 | end; 346 | end; 347 | 348 | 349 | {$i-} {Force I-} 350 | {---------------------------------------------------------------------------} 351 | procedure HashFile({$ifdef CONST} const {$endif} fname: Str255; PHash: PHashDesc; 352 | var Digest: THashDigest; var buf; bsize: word; var Err: word); 353 | {-Calulate hash digest of file, buf: buffer with at least bsize bytes} 354 | var 355 | {$ifdef VirtualPascal} 356 | fms: word; 357 | {$else} 358 | fms: byte; 359 | {$endif} 360 | {$ifndef BIT16} 361 | L: longint; 362 | {$else} 363 | L: word; 364 | {$endif} 365 | var 366 | Context: THashContext; 367 | f: file; 368 | begin 369 | if (PHash=nil) or (Phash^.HSig<>C_HashSig) then begin 370 | Err := 204; {Invalid pointer} 371 | exit; 372 | end; 373 | fms := FileMode; 374 | {$ifdef VirtualPascal} 375 | FileMode := $40; {open_access_ReadOnly or open_share_DenyNone;} 376 | {$else} 377 | FileMode := 0; 378 | {$endif} 379 | system.assign(f,{$ifdef D12Plus} string {$endif} (fname)); 380 | system.reset(f,1); 381 | Err := IOResult; 382 | FileMode := fms; 383 | if Err<>0 then exit; 384 | with PHash^ do begin 385 | HInit(Context); 386 | L := bsize; 387 | while (Err=0) and (L=bsize) do begin 388 | system.blockread(f,buf,bsize,L); 389 | Err := IOResult; 390 | HUpdateXL(Context, @buf, L); 391 | end; 392 | system.close(f); 393 | if IOResult=0 then {}; 394 | HFinal(Context, Digest); 395 | end; 396 | end; 397 | 398 | 399 | begin 400 | {$ifdef HAS_ASSERT} 401 | assert(sizeof(THashContext)=HASHCTXSIZE , '** Invalid sizeof(THashContext)'); 402 | {$else} 403 | if sizeof(THashContext)<>HASHCTXSIZE then RunError(227); 404 | {$endif} 405 | {Paranoia: initialize all descriptor pointers to nil (should} 406 | {be done by compiler/linker because array is in global data)} 407 | fillchar(PHashVec{%H-},sizeof(PHashVec),0); 408 | end. 409 | -------------------------------------------------------------------------------- /src/we/md5.pas: -------------------------------------------------------------------------------- 1 | unit MD5; 2 | 3 | {MD5 - 128 bit Hash function} 4 | 5 | 6 | interface 7 | 8 | (************************************************************************* 9 | 10 | DESCRIPTION : MD5 - 128 bit Hash function 11 | 12 | REQUIREMENTS : TP5-7, D1-D7/D9-D10/D12/D17-D18/D25S, FPC, VP 13 | 14 | EXTERNAL DATA : --- 15 | 16 | MEMORY USAGE : --- 17 | 18 | DISPLAY MODE : --- 19 | 20 | REFERENCES : RFC 1321 (http://tools.ietf.org/html/rfc1321) 21 | 22 | 23 | Version Date Author Modification 24 | ------- -------- ------- ------------------------------------------ 25 | 0.10 16.03.02 W.Ehrhardt Initial version based on SHA1 layout 26 | 0.20 16.03.02 we Basic trans: 4 func calls in a loop 27 | 0.21 25.01.03 we removed const in MD5Transform (TP6) 28 | 0.30 23.07.03 we With MD5File, MD5Full 29 | 0.31 26.07.03 we With MD5Full in self test, D6+ - warnings 30 | 2.00 26.07.03 we common vers., longint for word32, D4+ - warnings 31 | 2.01 03.08.03 we type TMD5Block for HMAC 32 | 2.10 29.08.03 we XL versions for Win32 33 | 2.20 27.09.03 we FPC/go32v2 34 | 2.30 05.10.03 we STD.INC, TP5.0 35 | 2.40 10.10.03 we common version, english comments 36 | 2.50 17.11.03 we Speedup in update, don't clear W in compress 37 | 2.51 17.11.03 we MD5Transform(hash, msg^) 38 | 2.52 17.11.03 we Full unroll 39 | 2.53 18.11.03 we 16 bit: partial unroll, 32 bit: full unroll via ifdef 40 | 2.54 18.11.03 we LRot32 mit inline() 41 | 2.55 20.11.03 we Full range UpdateLen 42 | 3.00 01.12.03 we Common version 3.0 43 | 3.01 24.12.03 we TP5/5.5: LRot inline 44 | 3.02 24.12.03 we Changed UpdateLen: Definition and TP5/5.5 inline 45 | 3.03 26.02.05 we With {$ifdef StrictLong} 46 | 3.04 05.05.05 we $R- for StrictLong, D9: errors if $R+ even if warnings off 47 | 3.05 17.12.05 we Force $I- in MD5File 48 | 3.06 15.01.06 we uses Hash unit and THashDesc 49 | 3.07 18.01.06 we Descriptor fields HAlgNum, HSig 50 | 3.08 22.01.06 we Removed HSelfTest from descriptor 51 | 3.09 11.02.06 we Descriptor as typed const 52 | 3.10 07.08.06 we $ifdef BIT32: (const fname: shortstring...) 53 | 3.11 22.02.07 we values for OID vector 54 | 3.12 30.06.07 we Use conditional define FPC_ProcVar 55 | 3.13 04.10.07 we FPC: {$asmmode intel} 56 | 3.14 02.05.08 we Bit-API: MD5FinalBits/Ex 57 | 3.15 05.05.08 we THashDesc constant with HFinalBit field 58 | 3.16 12.11.08 we uses BTypes, Ptr2Inc and/or Str255/Str127 59 | 3.17 25.04.09 we updated RFC URL(s) 60 | 3.18 26.12.12 we D17 and PurePascal 61 | 3.19 16.08.15 we Removed $ifdef DLL / stdcall 62 | 3.20 15.05.17 we adjust OID to new MaxOIDLen 63 | **************************************************************************) 64 | 65 | (*------------------------------------------------------------------------- 66 | (C) Copyright 2002-2017 Wolfgang Ehrhardt 67 | 68 | This software is provided 'as-is', without any express or implied warranty. 69 | In no event will the authors be held liable for any damages arising from 70 | the use of this software. 71 | 72 | Permission is granted to anyone to use this software for any purpose, 73 | including commercial applications, and to alter it and redistribute it 74 | freely, subject to the following restrictions: 75 | 76 | 1. The origin of this software must not be misrepresented; you must not 77 | claim that you wrote the original software. If you use this software in 78 | a product, an acknowledgment in the product documentation would be 79 | appreciated but is not required. 80 | 81 | 2. Altered source versions must be plainly marked as such, and must not be 82 | misrepresented as being the original software. 83 | 84 | 3. This notice may not be removed or altered from any source distribution. 85 | ----------------------------------------------------------------------------*) 86 | 87 | 88 | {$i STD.INC} 89 | 90 | {$ifdef BIT64} 91 | {$ifndef PurePascal} 92 | {$define PurePascal} 93 | {$endif} 94 | {$endif} 95 | 96 | uses 97 | BTypes,Hash; 98 | 99 | 100 | procedure MD5Init(var Context: THashContext); 101 | {-initialize context} 102 | 103 | procedure MD5Update(var Context: THashContext; Msg: pointer; Len: word); 104 | {-update context with Msg data} 105 | 106 | procedure MD5UpdateXL(var Context: THashContext; Msg: pointer; Len: longint); 107 | {-update context with Msg data} 108 | 109 | procedure MD5Final(var Context: THashContext; var Digest: TMD5Digest); 110 | {-finalize MD5 calculation, clear context} 111 | 112 | procedure MD5FinalEx(var Context: THashContext; var Digest: THashDigest); 113 | {-finalize MD5 calculation, clear context} 114 | 115 | procedure MD5FinalBitsEx(var Context: THashContext; var Digest: THashDigest; BData: byte; bitlen: integer); 116 | {-finalize MD5 calculation with bitlen bits from BData (big-endian), clear context} 117 | 118 | procedure MD5FinalBits(var Context: THashContext; var Digest: TMD5Digest; BData: byte; bitlen: integer); 119 | {-finalize MD5 calculation with bitlen bits from BData (big-endian), clear context} 120 | 121 | function MD5SelfTest: boolean; 122 | {-self test for string from MD5 document} 123 | 124 | procedure MD5Full(var Digest: TMD5Digest; Msg: pointer; Len: word); 125 | {-MD5 of Msg with init/update/final} 126 | 127 | procedure MD5FullXL(var Digest: TMD5Digest; Msg: pointer; Len: longint); 128 | {-MD5 of Msg with init/update/final} 129 | 130 | procedure MD5File({$ifdef CONST} const {$endif} fname: Str255; 131 | var Digest: TMD5Digest; var buf; bsize: word; var Err: word); 132 | {-MD5 of file, buf: buffer with at least bsize bytes} 133 | 134 | 135 | 136 | implementation 137 | 138 | 139 | {$ifdef BIT16} 140 | {$F-} 141 | {$endif} 142 | 143 | 144 | const 145 | MD5_BlockLen = 64; 146 | 147 | 148 | {1.2.840.113549.2.5} 149 | {iso(1) member-body(2) us(840) rsadsi(113549) digestAlgorithm(2) md5(5)} 150 | const 151 | MD5_OID : TOID_Vec = (1,2,840,113549,2,5,-1,-1,-1,-1,-1); {Len=6} 152 | 153 | 154 | {$ifndef VER5X} 155 | const 156 | MD5_Desc: THashDesc = ( 157 | HSig : C_HashSig; 158 | HDSize : sizeof(THashDesc); 159 | HDVersion : C_HashVers; 160 | HBlockLen : MD5_BlockLen; 161 | HDigestlen: sizeof(TMD5Digest); 162 | {$ifdef FPC_ProcVar} 163 | HInit : @MD5Init; 164 | HFinal : @MD5FinalEx; 165 | HUpdateXL : @MD5UpdateXL; 166 | {$else} 167 | HInit : MD5Init; 168 | HFinal : MD5FinalEx; 169 | HUpdateXL : MD5UpdateXL; 170 | {$endif} 171 | HAlgNum : longint(_MD5); 172 | HName : 'MD5'; 173 | HPtrOID : @MD5_OID; 174 | HLenOID : 6; 175 | HFill : 0; 176 | {$ifdef FPC_ProcVar} 177 | HFinalBit : @MD5FinalBitsEx; 178 | {$else} 179 | HFinalBit : MD5FinalBitsEx; 180 | {$endif} 181 | HReserved : (0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0) 182 | ); 183 | {$else} 184 | var 185 | MD5_Desc: THashDesc; 186 | {$endif} 187 | 188 | 189 | {$ifdef StrictLong} 190 | {$warnings off} 191 | {$R-} {avoid D9 errors!} 192 | {$endif} 193 | 194 | const 195 | t: array[0..63] of longint = ($d76aa478, $e8c7b756, $242070db, $c1bdceee, 196 | $f57c0faf, $4787c62a, $a8304613, $fd469501, 197 | $698098d8, $8b44f7af, $ffff5bb1, $895cd7be, 198 | $6b901122, $fd987193, $a679438e, $49b40821, 199 | $f61e2562, $c040b340, $265e5a51, $e9b6c7aa, 200 | $d62f105d, $02441453, $d8a1e681, $e7d3fbc8, 201 | $21e1cde6, $c33707d6, $f4d50d87, $455a14ed, 202 | $a9e3e905, $fcefa3f8, $676f02d9, $8d2a4c8a, 203 | $fffa3942, $8771f681, $6d9d6122, $fde5380c, 204 | $a4beea44, $4bdecfa9, $f6bb4b60, $bebfbc70, 205 | $289b7ec6, $eaa127fa, $d4ef3085, $04881d05, 206 | $d9d4d039, $e6db99e5, $1fa27cf8, $c4ac5665, 207 | $f4292244, $432aff97, $ab9423a7, $fc93a039, 208 | $655b59c3, $8f0ccc92, $ffeff47d, $85845dd1, 209 | $6fa87e4f, $fe2ce6e0, $a3014314, $4e0811a1, 210 | $f7537e82, $bd3af235, $2ad7d2bb, $eb86d391); 211 | 212 | {$ifdef StrictLong} 213 | {$warnings on} 214 | {$ifdef RangeChecks_on} 215 | {$R+} 216 | {$endif} 217 | {$endif} 218 | 219 | 220 | 221 | 222 | 223 | 224 | {$ifndef BIT16} 225 | 226 | 227 | {********* 32+ bit code *********} 228 | 229 | {$ifdef PurePascal} 230 | {---------------------------------------------------------------------------} 231 | procedure UpdateLen(var whi, wlo: longint; BLen: longint); 232 | {-Add BLen to 64 bit value (wlo, whi)} 233 | var 234 | tmp: int64; 235 | begin 236 | tmp := int64(cardinal(wlo))+Blen; 237 | wlo := longint(tmp and $FFFFFFFF); 238 | inc(whi,longint(tmp shr 32)); 239 | end; 240 | {$else} 241 | {---------------------------------------------------------------------------} 242 | procedure UpdateLen(var whi, wlo: longint; BLen: longint); 243 | {-Add BLen to 64 bit value (wlo, whi)} 244 | begin 245 | asm 246 | mov edx, [wlo] 247 | mov ecx, [whi] 248 | mov eax, [Blen] 249 | add [edx], eax 250 | adc dword ptr [ecx], 0 251 | end; 252 | end; 253 | {$endif} 254 | 255 | {---------------------------------------------------------------------------} 256 | procedure MD5Transform(var Hash: THashState; const Buffer: THashBuf32); 257 | {-MD5 basic transformation} 258 | var 259 | A, B, C, D: longint; 260 | begin 261 | A := Hash[0]; 262 | B := Hash[1]; 263 | C := Hash[2]; 264 | D := Hash[3]; 265 | 266 | inc(A, Buffer[ 0] + T[ 0] + (D xor (B and (C xor D)))); A := A shl 7 or A shr 25 + B; 267 | inc(D, Buffer[ 1] + T[ 1] + (C xor (A and (B xor C)))); D := D shl 12 or D shr 20 + A; 268 | inc(C, Buffer[ 2] + T[ 2] + (B xor (D and (A xor B)))); C := C shl 17 or C shr 15 + D; 269 | inc(B, Buffer[ 3] + T[ 3] + (A xor (C and (D xor A)))); B := B shl 22 or B shr 10 + C; 270 | inc(A, Buffer[ 4] + T[ 4] + (D xor (B and (C xor D)))); A := A shl 7 or A shr 25 + B; 271 | inc(D, Buffer[ 5] + T[ 5] + (C xor (A and (B xor C)))); D := D shl 12 or D shr 20 + A; 272 | inc(C, Buffer[ 6] + T[ 6] + (B xor (D and (A xor B)))); C := C shl 17 or C shr 15 + D; 273 | inc(B, Buffer[ 7] + T[ 7] + (A xor (C and (D xor A)))); B := B shl 22 or B shr 10 + C; 274 | inc(A, Buffer[ 8] + T[ 8] + (D xor (B and (C xor D)))); A := A shl 7 or A shr 25 + B; 275 | inc(D, Buffer[ 9] + T[ 9] + (C xor (A and (B xor C)))); D := D shl 12 or D shr 20 + A; 276 | inc(C, Buffer[10] + T[10] + (B xor (D and (A xor B)))); C := C shl 17 or C shr 15 + D; 277 | inc(B, Buffer[11] + T[11] + (A xor (C and (D xor A)))); B := B shl 22 or B shr 10 + C; 278 | inc(A, Buffer[12] + T[12] + (D xor (B and (C xor D)))); A := A shl 7 or A shr 25 + B; 279 | inc(D, Buffer[13] + T[13] + (C xor (A and (B xor C)))); D := D shl 12 or D shr 20 + A; 280 | inc(C, Buffer[14] + T[14] + (B xor (D and (A xor B)))); C := C shl 17 or C shr 15 + D; 281 | inc(B, Buffer[15] + T[15] + (A xor (C and (D xor A)))); B := B shl 22 or B shr 10 + C; 282 | 283 | inc(A, Buffer[ 1] + T[16] + (C xor (D and (B xor C)))); A := A shl 5 or A shr 27 + B; 284 | inc(D, Buffer[ 6] + T[17] + (B xor (C and (A xor B)))); D := D shl 9 or D shr 23 + A; 285 | inc(C, Buffer[11] + T[18] + (A xor (B and (D xor A)))); C := C shl 14 or C shr 18 + D; 286 | inc(B, Buffer[ 0] + T[19] + (D xor (A and (C xor D)))); B := B shl 20 or B shr 12 + C; 287 | inc(A, Buffer[ 5] + T[20] + (C xor (D and (B xor C)))); A := A shl 5 or A shr 27 + B; 288 | inc(D, Buffer[10] + T[21] + (B xor (C and (A xor B)))); D := D shl 9 or D shr 23 + A; 289 | inc(C, Buffer[15] + T[22] + (A xor (B and (D xor A)))); C := C shl 14 or C shr 18 + D; 290 | inc(B, Buffer[ 4] + T[23] + (D xor (A and (C xor D)))); B := B shl 20 or B shr 12 + C; 291 | inc(A, Buffer[ 9] + T[24] + (C xor (D and (B xor C)))); A := A shl 5 or A shr 27 + B; 292 | inc(D, Buffer[14] + T[25] + (B xor (C and (A xor B)))); D := D shl 9 or D shr 23 + A; 293 | inc(C, Buffer[ 3] + T[26] + (A xor (B and (D xor A)))); C := C shl 14 or C shr 18 + D; 294 | inc(B, Buffer[ 8] + T[27] + (D xor (A and (C xor D)))); B := B shl 20 or B shr 12 + C; 295 | inc(A, Buffer[13] + T[28] + (C xor (D and (B xor C)))); A := A shl 5 or A shr 27 + B; 296 | inc(D, Buffer[ 2] + T[29] + (B xor (C and (A xor B)))); D := D shl 9 or D shr 23 + A; 297 | inc(C, Buffer[ 7] + T[30] + (A xor (B and (D xor A)))); C := C shl 14 or C shr 18 + D; 298 | inc(B, Buffer[12] + T[31] + (D xor (A and (C xor D)))); B := B shl 20 or B shr 12 + C; 299 | 300 | inc(A, Buffer[ 5] + T[32] + (B xor C xor D)); A := A shl 4 or A shr 28 + B; 301 | inc(D, Buffer[ 8] + T[33] + (A xor B xor C)); D := D shl 11 or D shr 21 + A; 302 | inc(C, Buffer[11] + T[34] + (D xor A xor B)); C := C shl 16 or C shr 16 + D; 303 | inc(B, Buffer[14] + T[35] + (C xor D xor A)); B := B shl 23 or B shr 9 + C; 304 | inc(A, Buffer[ 1] + T[36] + (B xor C xor D)); A := A shl 4 or A shr 28 + B; 305 | inc(D, Buffer[ 4] + T[37] + (A xor B xor C)); D := D shl 11 or D shr 21 + A; 306 | inc(C, Buffer[ 7] + T[38] + (D xor A xor B)); C := C shl 16 or C shr 16 + D; 307 | inc(B, Buffer[10] + T[39] + (C xor D xor A)); B := B shl 23 or B shr 9 + C; 308 | inc(A, Buffer[13] + T[40] + (B xor C xor D)); A := A shl 4 or A shr 28 + B; 309 | inc(D, Buffer[ 0] + T[41] + (A xor B xor C)); D := D shl 11 or D shr 21 + A; 310 | inc(C, Buffer[ 3] + T[42] + (D xor A xor B)); C := C shl 16 or C shr 16 + D; 311 | inc(B, Buffer[ 6] + T[43] + (C xor D xor A)); B := B shl 23 or B shr 9 + C; 312 | inc(A, Buffer[ 9] + T[44] + (B xor C xor D)); A := A shl 4 or A shr 28 + B; 313 | inc(D, Buffer[12] + T[45] + (A xor B xor C)); D := D shl 11 or D shr 21 + A; 314 | inc(C, Buffer[15] + T[46] + (D xor A xor B)); C := C shl 16 or C shr 16 + D; 315 | inc(B, Buffer[ 2] + T[47] + (C xor D xor A)); B := B shl 23 or B shr 9 + C; 316 | 317 | inc(A, Buffer[ 0] + T[48] + (C xor (B or not D))); A := A shl 6 or A shr 26 + B; 318 | inc(D, Buffer[ 7] + T[49] + (B xor (A or not C))); D := D shl 10 or D shr 22 + A; 319 | inc(C, Buffer[14] + T[50] + (A xor (D or not B))); C := C shl 15 or C shr 17 + D; 320 | inc(B, Buffer[ 5] + T[51] + (D xor (C or not A))); B := B shl 21 or B shr 11 + C; 321 | inc(A, Buffer[12] + T[52] + (C xor (B or not D))); A := A shl 6 or A shr 26 + B; 322 | inc(D, Buffer[ 3] + T[53] + (B xor (A or not C))); D := D shl 10 or D shr 22 + A; 323 | inc(C, Buffer[10] + T[54] + (A xor (D or not B))); C := C shl 15 or C shr 17 + D; 324 | inc(B, Buffer[ 1] + T[55] + (D xor (C or not A))); B := B shl 21 or B shr 11 + C; 325 | inc(A, Buffer[ 8] + T[56] + (C xor (B or not D))); A := A shl 6 or A shr 26 + B; 326 | inc(D, Buffer[15] + T[57] + (B xor (A or not C))); D := D shl 10 or D shr 22 + A; 327 | inc(C, Buffer[ 6] + T[58] + (A xor (D or not B))); C := C shl 15 or C shr 17 + D; 328 | inc(B, Buffer[13] + T[59] + (D xor (C or not A))); B := B shl 21 or B shr 11 + C; 329 | inc(A, Buffer[ 4] + T[60] + (C xor (B or not D))); A := A shl 6 or A shr 26 + B; 330 | inc(D, Buffer[11] + T[61] + (B xor (A or not C))); D := D shl 10 or D shr 22 + A; 331 | inc(C, Buffer[ 2] + T[62] + (A xor (D or not B))); C := C shl 15 or C shr 17 + D; 332 | inc(B, Buffer[ 9] + T[63] + (D xor (C or not A))); B := B shl 21 or B shr 11 + C; 333 | 334 | inc(Hash[0], A); 335 | inc(Hash[1], B); 336 | inc(Hash[2], C); 337 | inc(Hash[3], D); 338 | end; 339 | 340 | 341 | {$else} 342 | 343 | {********* 16 bit code *********} 344 | 345 | {$ifdef BASM16} 346 | 347 | (** TP6-7/D1 **) 348 | 349 | {---------------------------------------------------------------------------} 350 | procedure UpdateLen(var whi, wlo: longint; BLen: longint); assembler; 351 | {-Add BLen to 64 bit value (wlo, whi)} 352 | asm 353 | les di,[wlo] 354 | db $66; mov ax,word ptr [BLen] 355 | db $66; sub dx,dx 356 | db $66; add es:[di],ax 357 | les di,[whi] 358 | db $66; adc es:[di],dx 359 | end; 360 | 361 | 362 | {---------------------------------------------------------------------------} 363 | function LRot32(X: longint; c: word): longint; 364 | inline( 365 | $59/ {pop cx } 366 | $66/$58/ {pop eax } 367 | $66/$D3/$C0/ {rol eax,cl } 368 | $66/$8B/$D0/ {mov edx,eax} 369 | $66/$C1/$EA/$10); {shr edx,16 } 370 | 371 | {$else} 372 | 373 | {** T5/5.5 **} 374 | 375 | {---------------------------------------------------------------------------} 376 | procedure UpdateLen(var whi, wlo: longint; BLen: longint); 377 | {-Add BLen to 64 bit value (wlo, whi)} 378 | inline( 379 | $58/ {pop ax } 380 | $5A/ {pop dx } 381 | $5B/ {pop bx } 382 | $07/ {pop es } 383 | $26/$01/$07/ {add es:[bx],ax } 384 | $26/$11/$57/$02/ {adc es:[bx+02],dx} 385 | $5B/ {pop bx } 386 | $07/ {pop es } 387 | $26/$83/$17/$00/ {adc es:[bx],0 } 388 | $26/$83/$57/$02/$00);{adc es:[bx+02],0 } 389 | 390 | 391 | {---------------------------------------------------------------------------} 392 | function LRot32(X: longint; c: word): longint; 393 | {-Rotate left} 394 | inline( 395 | $59/ { pop cx } 396 | $58/ { pop ax } 397 | $5A/ { pop dx } 398 | 399 | $83/$F9/$10/ { cmp cx,16 } 400 | $72/$06/ { jb L } 401 | $92/ { xchg dx,ax } 402 | $83/$E9/$10/ { sub cx,16 } 403 | $74/$09/ { je X } 404 | 405 | $2B/$DB/ {S:sub bx,bx } 406 | $D1/$D0/ {L:rcl ax,1 } 407 | $D1/$D2/ { rcl dx,1 } 408 | $13/$C3/ { adc ax,bx } 409 | $49/ { dec cx } 410 | $75/$F7); { jne L } 411 | {X: } 412 | 413 | {$endif BASM16} 414 | 415 | const 416 | {buffer index in loop} 417 | PX: array[0..63] of word = ( 0, 1, 2, 3, 4, 5, 6, 7, 418 | 8, 9, 10, 11, 12, 13, 14, 15, 419 | 1, 6, 11, 0, 5, 10, 15, 4, 420 | 9, 14, 3, 8, 13, 2, 7, 12, 421 | 5, 8, 11, 14, 1, 4, 7, 10, 422 | 13, 0, 3, 6, 9, 12, 15, 2, 423 | 0, 7, 14, 5, 12, 3, 10, 1, 424 | 8, 15, 6, 13, 4, 11, 2, 9); 425 | 426 | 427 | {---------------------------------------------------------------------------} 428 | procedure MD5Transform(var Hash: THashState; {$ifdef CONST} const {$else} var {$endif} Buffer: THashBuf32); 429 | {-MD5 basic transformation, 4 function calls in loop} 430 | var 431 | A, B, C, D: longint; 432 | i,k: integer; 433 | begin 434 | A := Hash[0]; 435 | B := Hash[1]; 436 | C := Hash[2]; 437 | D := Hash[3]; 438 | k := 0; 439 | {16 bit code: 4 functions inline, rotateleft via function} 440 | for i:=0 to 3 do begin 441 | inc(A, Buffer[k] + T[k] + (D xor (B and (C xor D)))); A := LRot32(A, 7) + B; inc(k); 442 | inc(D, Buffer[k] + T[k] + (C xor (A and (B xor C)))); D := LRot32(D, 12) + A; inc(k); 443 | inc(C, Buffer[k] + T[k] + (B xor (D and (A xor B)))); C := LRot32(C, 17) + D; inc(k); 444 | inc(B, Buffer[k] + T[k] + (A xor (C and (D xor A)))); B := LRot32(B, 22) + C; inc(k); 445 | end; 446 | for i:=0 to 3 do begin 447 | inc(A, Buffer[PX[k]] + T[k] + (C xor (D and (B xor C)))); A := LRot32(A, 5) + B; inc(k); 448 | inc(D, Buffer[PX[k]] + T[k] + (B xor (C and (A xor B)))); D := LRot32(D, 9) + A; inc(k); 449 | inc(C, Buffer[PX[k]] + T[k] + (A xor (B and (D xor A)))); C := LRot32(C, 14) + D; inc(k); 450 | inc(B, Buffer[PX[k]] + T[k] + (D xor (A and (C xor D)))); B := LRot32(B, 20) + C; inc(k); 451 | end; 452 | for i:=0 to 3 do begin 453 | inc(A, Buffer[PX[k]] + T[k] + (B xor C xor D)); A := LRot32(A, 4) + B; inc(k); 454 | inc(D, Buffer[PX[k]] + T[k] + (A xor B xor C)); D := LRot32(D, 11) + A; inc(k); 455 | inc(C, Buffer[PX[k]] + T[k] + (D xor A xor B)); C := LRot32(C, 16) + D; inc(k); 456 | inc(B, Buffer[PX[k]] + T[k] + (C xor D xor A)); B := LRot32(B, 23) + C; inc(k); 457 | end; 458 | for i:=0 to 3 do begin 459 | inc(A, Buffer[PX[k]] + T[k] + (C xor (B or not D))); A := LRot32(A, 6) + B; inc(k); 460 | inc(D, Buffer[PX[k]] + T[k] + (B xor (A or not C))); D := LRot32(D, 10) + A; inc(k); 461 | inc(C, Buffer[PX[k]] + T[k] + (A xor (D or not B))); C := LRot32(C, 15) + D; inc(k); 462 | inc(B, Buffer[PX[k]] + T[k] + (D xor (C or not A))); B := LRot32(B, 21) + C; inc(k); 463 | end; 464 | inc(Hash[0], A); 465 | inc(Hash[1], B); 466 | inc(Hash[2], C); 467 | inc(Hash[3], D); 468 | end; 469 | 470 | 471 | {$endif} 472 | 473 | 474 | {---------------------------------------------------------------------------} 475 | procedure MD5Init(var Context: THashContext); 476 | {-initialize context} 477 | begin 478 | {-initialize context and buffer to 0} 479 | fillchar(Context,sizeof(Context),0); 480 | with Context do begin 481 | Hash[0] := longint($67452301); 482 | Hash[1] := longint($EFCDAB89); 483 | Hash[2] := longint($98BADCFE); 484 | Hash[3] := longint($10325476); 485 | end; 486 | end; 487 | 488 | 489 | {---------------------------------------------------------------------------} 490 | procedure MD5UpdateXL(var Context: THashContext; Msg: pointer; Len: longint); 491 | {-update context with Msg data} 492 | var 493 | i: integer; 494 | begin 495 | {Update message bit length} 496 | if Len<=$1FFFFFFF then UpdateLen(Context.MLen[1], Context.MLen[0], Len shl 3) 497 | else begin 498 | for i:=1 to 8 do UpdateLen(Context.MLen[1], Context.MLen[0], Len) 499 | end; 500 | 501 | while Len > 0 do begin 502 | {fill block with msg data} 503 | Context.Buffer[Context.Index]:= pByte(Msg)^; 504 | inc(Ptr2Inc(Msg)); 505 | inc(Context.Index); 506 | dec(Len); 507 | if Context.Index=MD5_BlockLen then begin 508 | {If 512 bit transferred, compress a block} 509 | Context.Index:= 0; 510 | MD5Transform(Context.Hash, THashBuf32(Context.Buffer)); 511 | while Len>=MD5_BlockLen do begin 512 | MD5Transform(Context.Hash, THashBuf32(Msg^)); 513 | inc(Ptr2Inc(Msg),MD5_BlockLen); 514 | dec(Len,MD5_BlockLen); 515 | end; 516 | end; 517 | end; 518 | end; 519 | 520 | 521 | {---------------------------------------------------------------------------} 522 | procedure MD5Update(var Context: THashContext; Msg: pointer; Len: word); 523 | {-update context with Msg data} 524 | begin 525 | MD5UpdateXL(Context, Msg, Len); 526 | end; 527 | 528 | 529 | {---------------------------------------------------------------------------} 530 | procedure MD5FinalBitsEx(var Context: THashContext; var Digest: THashDigest; BData: byte; bitlen: integer); 531 | {-finalize MD5 calculation with bitlen bits from BData (big-endian), clear context} 532 | var 533 | i: integer; 534 | begin 535 | {Message padding} 536 | {append bits from BData and a single '1' bit} 537 | if (bitlen>0) and (bitlen<=7) then begin 538 | Context.Buffer[Context.Index]:= (BData and BitAPI_Mask[bitlen]) or BitAPI_PBit[bitlen]; 539 | UpdateLen(Context.MLen[1], Context.MLen[0], bitlen); 540 | end 541 | else Context.Buffer[Context.Index]:= $80; 542 | 543 | for i:=Context.Index+1 to 63 do Context.Buffer[i] := 0; 544 | {2. Compress if more than 448 bits, (no room for 64 bit length} 545 | if Context.Index>= 56 then begin 546 | MD5Transform(Context.Hash, THashBuf32(Context.Buffer)); 547 | fillchar(Context.Buffer,56,0); 548 | end; 549 | {Write 64 bit msg length into the last bits of the last block} 550 | {and do a final compress} 551 | THashBuf32(Context.Buffer)[14] := Context.MLen[0]; 552 | THashBuf32(Context.Buffer)[15] := Context.MLen[1]; 553 | MD5Transform(Context.Hash, THashBuf32(Context.Buffer)); 554 | {Hash to Digest} 555 | Move(Context.Hash,Digest,sizeof(Digest)); 556 | {Clear context} 557 | fillchar(Context,sizeof(Context),0); 558 | end; 559 | 560 | 561 | {---------------------------------------------------------------------------} 562 | procedure MD5FinalBits(var Context: THashContext; var Digest: TMD5Digest; BData: byte; bitlen: integer); 563 | {-finalize MD5 calculation with bitlen bits from BData (big-endian), clear context} 564 | var 565 | tmp: THashDigest; 566 | begin 567 | MD5FinalBitsEx(Context, tmp, BData, bitlen); 568 | move(tmp, Digest, sizeof(Digest)); 569 | end; 570 | 571 | 572 | {---------------------------------------------------------------------------} 573 | procedure MD5FinalEx(var Context: THashContext; var Digest: THashDigest); 574 | {-finalize MD5 calculation, clear context} 575 | begin 576 | MD5FinalBitsEx(Context,Digest,0,0); 577 | end; 578 | 579 | {---------------------------------------------------------------------------} 580 | procedure MD5Final(var Context: THashContext; var Digest: TMD5Digest); 581 | {-finalize MD5 calculation, clear context} 582 | var 583 | tmp: THashDigest; 584 | begin 585 | MD5FinalBitsEx(Context, tmp, 0, 0); 586 | move(tmp, Digest, sizeof(Digest)); 587 | end; 588 | 589 | 590 | {---------------------------------------------------------------------------} 591 | function MD5SelfTest: boolean; 592 | {-self test for string from MD5 document} 593 | const 594 | s1: string[ 3] = 'abc'; 595 | s2: string[62] = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789'; 596 | D1: TMD5Digest= ($90,$01,$50,$98,$3c,$d2,$4f,$b0,$d6,$96,$3f,$7d,$28,$e1,$7f,$72); 597 | D2: TMD5Digest= ($d1,$74,$ab,$98,$d2,$77,$d9,$f5,$a5,$61,$1c,$2c,$9f,$41,$9d,$9f); 598 | D3: TMD5Digest= ($1d,$a6,$35,$b1,$43,$0f,$17,$1c,$65,$72,$06,$fd,$69,$fe,$e0,$e8); 599 | var 600 | Context: THashContext; 601 | Digest : TMD5Digest; 602 | 603 | function SingleTest(s: Str255; TDig: TMD5Digest): boolean; 604 | {-do a single test, const not allowed for VER<7} 605 | { Two sub tests: 1. whole string, 2. one update per char} 606 | var 607 | i: integer; 608 | begin 609 | SingleTest := false; 610 | {1. Hash complete string} 611 | MD5Full(Digest,@s[1],length(s)); 612 | {Compare with known value} 613 | if not HashSameDigest(@MD5_Desc, PHashDigest(@Digest), PHashDigest(@TDig)) then exit; 614 | {2. one update call for all chars} 615 | MD5Init(Context); 616 | for i:=1 to length(s) do MD5Update(Context,@s[i],1); 617 | MD5Final(Context,Digest); 618 | {Compare with known value} 619 | if not HashSameDigest(@MD5_Desc, PHashDigest(@Digest), PHashDigest(@TDig)) then exit; 620 | SingleTest := true; 621 | end; 622 | 623 | begin 624 | MD5SelfTest := false; 625 | {1 Zero bit from NESSIE test vectors} 626 | MD5Init(Context); 627 | MD5FinalBits(Context,Digest,0,1); 628 | if not HashSameDigest(@MD5_Desc, PHashDigest(@Digest), PHashDigest(@D3)) then exit; 629 | {strings from MD5 document} 630 | MD5SelfTest := SingleTest(s1, D1) and SingleTest(s2, D2) 631 | end; 632 | 633 | 634 | {---------------------------------------------------------------------------} 635 | procedure MD5FullXL(var Digest: TMD5Digest; Msg: pointer; Len: longint); 636 | {-MD5 of Msg with init/update/final} 637 | var 638 | Context: THashContext; 639 | begin 640 | MD5Init(Context); 641 | MD5UpdateXL(Context, Msg, Len); 642 | MD5Final(Context, Digest); 643 | end; 644 | 645 | 646 | {---------------------------------------------------------------------------} 647 | procedure MD5Full(var Digest: TMD5Digest; Msg: pointer; Len: word); 648 | {-MD5 of Msg with init/update/final} 649 | begin 650 | MD5FullXL(Digest, Msg, Len); 651 | end; 652 | 653 | 654 | {---------------------------------------------------------------------------} 655 | procedure MD5File({$ifdef CONST} const {$endif} fname: Str255; 656 | var Digest: TMD5Digest; var buf; bsize: word; var Err: word); 657 | {-MD5 of file, buf: buffer with at least bsize bytes} 658 | var 659 | tmp: THashDigest; 660 | begin 661 | HashFile(fname, @MD5_Desc, tmp, buf, bsize, Err); 662 | move(tmp, Digest, sizeof(Digest)); 663 | end; 664 | 665 | 666 | begin 667 | {$ifdef VER5X} 668 | fillchar(MD5_Desc, sizeof(MD5_Desc), 0); 669 | with MD5_Desc do begin 670 | HSig := C_HashSig; 671 | HDSize := sizeof(THashDesc); 672 | HDVersion := C_HashVers; 673 | HBlockLen := MD5_BlockLen; 674 | HDigestlen:= sizeof(TMD5Digest); 675 | HInit := MD5Init; 676 | HFinal := MD5FinalEx; 677 | HUpdateXL := MD5UpdateXL; 678 | HAlgNum := longint(_MD5); 679 | HName := 'MD5'; 680 | HPtrOID := @MD5_OID; 681 | HLenOID := 6; 682 | HFinalBit := MD5FinalBitsEx; 683 | end; 684 | {$endif} 685 | RegisterHash(_MD5, @MD5_Desc); 686 | end. 687 | -------------------------------------------------------------------------------- /src/we/mem_util.pas: -------------------------------------------------------------------------------- 1 | unit Mem_Util; 2 | 3 | 4 | {Utility procedures for Hex/Base64 and memory compare} 5 | 6 | 7 | interface 8 | 9 | 10 | {$i STD.INC} 11 | 12 | (************************************************************************* 13 | 14 | DESCRIPTION : Utility procedures for Hex/Base64 and memory compare 15 | 16 | REQUIREMENTS : TP5-7, D1-D7/D9-D10/D12, FPC, VP, WDOSX 17 | 18 | EXTERNAL DATA : --- 19 | 20 | MEMORY USAGE : --- 21 | 22 | DISPLAY MODE : --- 23 | 24 | REFERENCES : RFC 3548 - The Base16, Base32, and Base64 Data Encodings 25 | 26 | 27 | Version Date Author Modification 28 | ------- -------- ------- ------------------------------------------ 29 | 0.10 01.01.02 W.Ehrhardt Initial version 30 | 0.20 30.08.03 we with pointer valid for all compilers 31 | 0.30 17.09.03 we with HexLong 32 | 0.40 27.09.03 we FPC/go32v2 33 | 0.50 05.10.03 we STD.INC 34 | 0.60 10.10.03 we english comments 35 | 0.70 26.12.03 we Base64Str 36 | 0.80 12.04.04 we HexUpper, Delphi 7 37 | 0.81 12.06.04 we handle nil pointers 38 | 0.90 05.12.04 we Hex2Mem 39 | 0.91 31.10.05 we Simple Base64Enc/DecStr, D9/WDOSX, Base64Str with result 40 | 0.92 11.12.05 we Bugfix: Hex2Mem and $R+ 41 | 0.93 07.02.06 we RandMem 42 | 0.94 14.10.07 we HexWord 43 | 0.95 25.09.08 we uses BTypes 44 | 0.96 14.11.08 we BString, char8, Ptr2Inc 45 | 0.97 05.07.09 we D12 fix for Hex2Mem 46 | 0.98 27.07.10 we CompMemXL, RandMemXL 47 | 0.99 25.09.10 we CompMemXL returns true if size <= 0 48 | **************************************************************************) 49 | 50 | 51 | (*------------------------------------------------------------------------- 52 | (C) Copyright 2002-2010 Wolfgang Ehrhardt 53 | 54 | This software is provided 'as-is', without any express or implied warranty. 55 | In no event will the authors be held liable for any damages arising from 56 | the use of this software. 57 | 58 | Permission is granted to anyone to use this software for any purpose, 59 | including commercial applications, and to alter it and redistribute it 60 | freely, subject to the following restrictions: 61 | 62 | 1. The origin of this software must not be misrepresented; you must not 63 | claim that you wrote the original software. If you use this software in 64 | a product, an acknowledgment in the product documentation would be 65 | appreciated but is not required. 66 | 67 | 2. Altered source versions must be plainly marked as such, and must not be 68 | misrepresented as being the original software. 69 | 70 | 3. This notice may not be removed or altered from any source distribution. 71 | ----------------------------------------------------------------------------*) 72 | 73 | uses 74 | BTypes; 75 | 76 | var 77 | HexUpper: boolean; {Hex strings in uppercase} 78 | 79 | function HexByte(b: byte): BString; 80 | {-byte as hex string} 81 | 82 | function HexWord(w: word): BString; 83 | {-word as hex string} 84 | 85 | function HexLong(L: longint): BString; 86 | {-longint as hex string, LSB first} 87 | 88 | function HexStr(psrc: pointer; L: integer): BString; 89 | {-hex string of memory block of length L pointed by psrc} 90 | 91 | procedure Hex2Mem({$ifdef CONST}const{$endif} s: BString; pdest: pointer; MaxL: word; var L: word); 92 | {-Convert hex string to mem pointed by pdest, MaxL bytes, actual byte count in L} 93 | 94 | function Base64Str(psrc: pointer; L: integer): BString; 95 | {-Base64 string of memory block of length L pointed by psrc} 96 | 97 | function Base64EncStr({$ifdef CONST}const{$endif} s: BString): BString; 98 | {-Simple Base64 encoder, uses Base64Str} 99 | 100 | function Base64DecStr({$ifdef CONST}const{$endif} es: BString): BString; 101 | {-Simple Base64 decoder, stops conversion on first invalid char} 102 | 103 | function CompMem(psrc, pdest: pointer; size: word): boolean; 104 | {-compare memory block} 105 | 106 | procedure RandMem(pdest: pointer; size: word); 107 | {-fill memory block with size random bytes} 108 | 109 | function CompMemXL(psrc, pdest: pointer; size: longint): boolean; 110 | {-compare memory block} 111 | 112 | procedure RandMemXL(pdest: pointer; size: longint); 113 | {-fill memory block with size random bytes} 114 | 115 | 116 | implementation 117 | 118 | 119 | const 120 | CT64: array[0..63] of char8 = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/'; 121 | 122 | 123 | {---------------------------------------------------------------------------} 124 | function HexByte(b: byte): BString; 125 | {-byte as hex string} 126 | const 127 | nib: array[0..15] of char8 = '0123456789abcdef'; 128 | begin 129 | if HexUpper then HexByte := upcase(nib[b div 16]) + upcase(nib[b and 15]) 130 | else HexByte := nib[b div 16] + nib[b and 15]; 131 | end; 132 | 133 | 134 | {---------------------------------------------------------------------------} 135 | function HexWord(w: word): BString; 136 | {-word as hex string} 137 | begin 138 | HexWord := HexByte(w shr 8)+HexByte(w and $FF); 139 | end; 140 | 141 | 142 | {---------------------------------------------------------------------------} 143 | function HexLong(L: longint): BString; 144 | {-longint as hex string, LSB first} 145 | var 146 | i: integer; 147 | s: string[8]; 148 | begin 149 | s := ''; 150 | for i:=0 to 3 do begin 151 | s := HexByte(L and $FF) + s; 152 | L := L shr 8; 153 | end; 154 | HexLong := s; 155 | end; 156 | 157 | 158 | {---------------------------------------------------------------------------} 159 | function HexStr(psrc: pointer; L: integer): BString; 160 | {-hex string of memory block of length L pointed by psrc} 161 | var 162 | i: integer; 163 | s: BString; 164 | begin 165 | s := ''; 166 | if psrc<>nil then begin 167 | for i:=0 to L-1 do begin 168 | s := s + HexByte(pByte(psrc)^); 169 | inc(Ptr2Inc(psrc)); 170 | end; 171 | end; 172 | HexStr := s; 173 | end; 174 | 175 | 176 | {---------------------------------------------------------------------------} 177 | procedure Hex2Mem({$ifdef CONST}const{$endif} s: BString; pdest: pointer; MaxL: word; var L: word); 178 | {-Convert hex string to mem pointed by pdest, MaxL bytes, actual byte count in L} 179 | const 180 | nib: array[0..15] of char8 = '0123456789ABCDEF'; 181 | wsp: array[0..3] of char8 = #32#9#13#10; 182 | label 183 | _break; {for versions without break} 184 | var 185 | i,p: integer; 186 | b: byte; 187 | c: char8; 188 | bdone: boolean; {flag byte complete} 189 | begin 190 | L := 0; 191 | if MaxL=0 then exit; 192 | bdone := true; 193 | b := 0; 194 | for i:=1 to length(s) do begin 195 | c := upcase(s[i]); 196 | p := pos(c,nib)-1; 197 | if p>=0 then begin 198 | {Insert new nibble into b. If range checking is on, we} 199 | {must prevent the following shift from overflowing b. } 200 | {$ifopt R+} 201 | b := ((b and $F) shl 4) or (p and $0F); 202 | {$else} 203 | b := (b shl 4) {%H-}or (p and $0F); 204 | {$endif} 205 | bdone := not bdone; 206 | if bdone then begin 207 | {byte complete, store or break} 208 | if L<MaxL then begin 209 | pByte(pdest)^ := b; 210 | inc(Ptr2Inc(pdest)); 211 | inc(L); 212 | end 213 | else goto _break; 214 | end; 215 | end 216 | else begin 217 | {ignore white space} 218 | if pos(c,wsp)=0 then goto _break; 219 | end; 220 | end; 221 | 222 | _break: 223 | 224 | if (not bdone) and (L<MaxL) then begin 225 | {store remaining nibble} 226 | pByte(pdest)^ := (b and $0F) shl 4; 227 | inc(L); 228 | end; 229 | end; 230 | 231 | 232 | {---------------------------------------------------------------------------} 233 | function Base64Str(psrc: pointer; L: integer): BString; 234 | {-Base64 string of memory block of length L pointed by psrc} 235 | var 236 | q,r: integer; 237 | b0,b1,b2: byte; 238 | //{$ifndef RESULT} 239 | // result: BString; 240 | //{$endif} 241 | begin 242 | result := ''; 243 | if (L>0) and (psrc<>nil) then begin 244 | q := L div 3; 245 | r := L mod 3; 246 | while q>0 do begin 247 | b0 := pByte(psrc)^; inc(Ptr2Inc(psrc)); 248 | b1 := pByte(psrc)^; inc(Ptr2Inc(psrc)); 249 | b2 := pByte(psrc)^; inc(Ptr2Inc(psrc)); 250 | result := result + CT64[(b0 shr 2) and $3f] 251 | + CT64[((b0 shl 4) and $30) or ((b1 shr 4) and $0f)] 252 | + CT64[((b1 shl 2) and $3c) or ((b2 shr 6) and $03)] 253 | + CT64[b2 and $3f]; 254 | dec(q); 255 | end; 256 | if r=2 then begin 257 | b0 := pByte(psrc)^; inc(Ptr2Inc(psrc)); 258 | b1 := pByte(psrc)^; 259 | result := result + CT64[(b0 shr 2) and $3f] 260 | + CT64[((b0 shl 4) and $30) or ((b1 shr 4) and $0f)] 261 | + CT64[(b1 shl 2) and $3c] 262 | + '='; 263 | end 264 | else if r=1 then begin 265 | b0 := pByte(psrc)^; 266 | result := result + CT64[(b0 shr 2) and $3f] 267 | + CT64[(b0 shl 4) and $30] 268 | + '=='; 269 | end; 270 | end; 271 | //{$ifndef RESULT} 272 | // Base64Str := result; 273 | //{$endif} 274 | end; 275 | 276 | 277 | {---------------------------------------------------------------------------} 278 | function Base64EncStr({$ifdef CONST}const{$endif} s: BString): BString; 279 | {-Simple Base64 encoder, uses Base64Str} 280 | begin 281 | Base64EncStr := Base64Str(@s[1], length(s)); 282 | end; 283 | 284 | 285 | {---------------------------------------------------------------------------} 286 | function Base64DecStr({$ifdef CONST}const{$endif} es: BString): BString; 287 | {-Simple Base64 decoder, stops conversion on first invalid char} 288 | var 289 | i,bits,buf: word; 290 | //{$ifndef RESULT} 291 | // result: BString; 292 | //{$endif} 293 | ic: array[char8] of byte; 294 | b: byte; 295 | label 296 | _break; {for TP5/5.5} 297 | begin 298 | {Note: this is a stripped down version of Base2N.Decode2NPrim} 299 | result := ''; 300 | {Fill input array with Base64 digit values, $FF if not valid} 301 | fillchar(IC, sizeof(IC), $FF); 302 | for i:=0 to 63 do ic[CT64[i]] := i; 303 | buf := 0; 304 | bits := 0; 305 | for i:=1 to length(es) do begin 306 | b := IC[es[i]]; 307 | if b>127 then goto _break; 308 | {Include next input into buffer. If range checking is on, } 309 | {we must prevent the following shift from overflowing buf.} 310 | {$ifopt R+} 311 | buf := ((buf and $03FF) shl 6) or b; 312 | {$else} 313 | buf := (buf shl 6) or b; 314 | {$endif} 315 | inc(bits,6); 316 | if bits>7 then begin 317 | {output a byte if at least 8 bits in input buf} 318 | dec(bits,8); 319 | result := result + char8((buf shr bits) and $FF); 320 | end; 321 | end; 322 | 323 | _break: 324 | 325 | {$ifndef RESULT} 326 | Base64DecStr := result; 327 | {$endif} 328 | end; 329 | 330 | 331 | {---------------------------------------------------------------------------} 332 | function CompMemXL(psrc, pdest: pointer; size: longint): boolean; 333 | {-compare memory block} 334 | var 335 | i: longint; 336 | begin 337 | if size>0 then begin 338 | CompMemXL := false; 339 | if (psrc=nil) or (pdest=nil) then exit; 340 | for i:=1 to size do begin 341 | if pByte(psrc)^<>pByte(pdest)^ then exit; 342 | inc(Ptr2Inc(psrc)); 343 | inc(Ptr2Inc(pdest)); 344 | end; 345 | end; 346 | CompMemXL := true; 347 | end; 348 | 349 | 350 | {---------------------------------------------------------------------------} 351 | procedure RandMemXL(pdest: pointer; size: longint); 352 | {-fill memory block with size random bytes} 353 | var 354 | i: longint; 355 | begin 356 | if pdest<>nil then begin 357 | for i:=1 to size do begin 358 | pByte(pdest)^ := random(256); 359 | inc(Ptr2Inc(pdest)); 360 | end; 361 | end; 362 | end; 363 | 364 | 365 | {---------------------------------------------------------------------------} 366 | function CompMem(psrc, pdest: pointer; size: word): boolean; 367 | {-compare memory block} 368 | begin 369 | CompMem := CompMemXL(psrc, pdest, size); 370 | end; 371 | 372 | 373 | {---------------------------------------------------------------------------} 374 | procedure RandMem(pdest: pointer; size: word); 375 | {-fill memory block with size random bytes} 376 | begin 377 | RandMemXL(pdest, size); 378 | end; 379 | 380 | 381 | begin 382 | HexUpper := false; 383 | end. 384 | -------------------------------------------------------------------------------- /src/we/sha1.pas: -------------------------------------------------------------------------------- 1 | unit SHA1; 2 | 3 | {SHA1 - 160 bit Secure Hash Function} 4 | 5 | 6 | interface 7 | 8 | (************************************************************************* 9 | 10 | DESCRIPTION : SHA1 - 160 bit Secure Hash Function 11 | 12 | REQUIREMENTS : TP5-7, D1-D7/D9-D10/D12/D17-D18/D25S, FPC, VP 13 | 14 | EXTERNAL DATA : --- 15 | 16 | MEMORY USAGE : --- 17 | 18 | DISPLAY MODE : --- 19 | 20 | REFERENCES : - Latest specification of Secure Hash Standard: 21 | http://csrc.nist.gov/publications/fips/fips180-4/fips-180-4.pdf 22 | - Test vectors and intermediate values: 23 | http://csrc.nist.gov/groups/ST/toolkit/documents/Examples/SHA_All.pdf 24 | 25 | 26 | Version Date Author Modification 27 | ------- -------- ------- ------------------------------------------ 28 | 1.00 03.01.02 W.Ehrhardt BP7 implementation 29 | 1.01 14.03.02 we D1-D6, FPC, VP 30 | 1.02 14.03.02 we TP6 31 | 1.03 14.03.02 we TP6/7 386-Code 32 | 1.04 14.03.02 we TP5.5 33 | 1.10 15.03.02 we self test with 2 strings 34 | 1.11 02.01.03 we const SFA with @ for FPC 1.0.6 35 | 1.20 23.07.03 we With SHA1File, SHA1Full 36 | 1.21 26.07.03 we With SHA1Full in self test 37 | 2.00 26.07.03 we common vers., longint for word32, D4+ - warnings 38 | 2.01 03.08.03 we type TSHA1Block for HMAC 39 | 2.02 23.08.03 we SHA1Compress in interface for prng 40 | 2.10 29.08.03 we XL versions for Win32 41 | 2.20 27.09.03 we FPC/go32v2 42 | 2.30 05.10.03 we STD.INC, TP5.0 43 | 2.40 10.10.03 we common version, english comments 44 | 2.45 11.10.03 we Speedup: partial unroll, no function calls 45 | 2.50 16.11.03 we Speedup in update, don't clear W in compress 46 | 2.51 17.11.03 we BIT16: partial unroll, BIT32: inline rot 47 | 2.52 17.11.03 we ExpandMessageBlocks 48 | 2.53 18.11.03 we LRot32, RB mit inline() 49 | 2.54 20.11.03 we Full range UpdateLen 50 | 2.55 30.11.03 we BIT16: {$F-} 51 | 2.56 30.11.03 we BIT16: LRot_5, LRot_30 52 | 3.00 01.12.03 we Common version 3.0 53 | 3.01 22.12.03 we BIT16: Two INCs 54 | 3.02 22.12.03 we BASM16: asm Lrot30 55 | 3.03 22.12.03 we TP5/5.5: LRot, RA inline 56 | 3.04 22,12.03 we Changed UpdateLen: Definition and TP5/5.5 inline 57 | 3.05 05.03.04 we Update fips180-2 URL 58 | 3.06 26.02.05 we With {$ifdef StrictLong} 59 | 3.07 05.05.05 we Use longint() in SH1Init to avoid D9 errors if $R+ 60 | 3.08 17.12.05 we Force $I- in SHA1File 61 | 3.09 08.01.06 we SHA1Compress removed from interface 62 | 3.10 15.01.06 we uses Hash unit and THashDesc 63 | 3.11 18.01.06 we Descriptor fields HAlgNum, HSig 64 | 3.12 22.01.06 we Removed HSelfTest from descriptor 65 | 3.13 11.02.06 we Descriptor as typed const 66 | 3.14 26.03.06 we Round constants K1..K4, code reordering 67 | 3.15 07.08.06 we $ifdef BIT32: (const fname: shortstring...) 68 | 3.16 22.02.07 we values for OID vector 69 | 3.17 30.06.07 we Use conditional define FPC_ProcVar 70 | 3.18 04.10.07 we FPC: {$asmmode intel} 71 | 3.19 02.05.08 we Bit-API: SHA1FinalBits/Ex 72 | 3.20 05.05.08 we THashDesc constant with HFinalBit field 73 | 3.21 12.11.08 we uses BTypes, Ptr2Inc and/or Str255/Str127 74 | 3.22 12.03.10 we Fix VP feature in ExpandMessageBlocks 75 | 3.23 11.03.12 we Updated references 76 | 3.24 26.12.12 we D17 and PurePascal 77 | 3.25 16.08.15 we Removed $ifdef DLL / stdcall 78 | 3.26 15.05.17 we adjust OID to new MaxOIDLen 79 | **************************************************************************) 80 | 81 | 82 | (*------------------------------------------------------------------------- 83 | (C) Copyright 2002-2017 Wolfgang Ehrhardt 84 | 85 | This software is provided 'as-is', without any express or implied warranty. 86 | In no event will the authors be held liable for any damages arising from 87 | the use of this software. 88 | 89 | Permission is granted to anyone to use this software for any purpose, 90 | including commercial applications, and to alter it and redistribute it 91 | freely, subject to the following restrictions: 92 | 93 | 1. The origin of this software must not be misrepresented; you must not 94 | claim that you wrote the original software. If you use this software in 95 | a product, an acknowledgment in the product documentation would be 96 | appreciated but is not required. 97 | 98 | 2. Altered source versions must be plainly marked as such, and must not be 99 | misrepresented as being the original software. 100 | 101 | 3. This notice may not be removed or altered from any source distribution. 102 | ----------------------------------------------------------------------------*) 103 | 104 | {NOTE: FIPS Ch and May functions can be optimized. Wei Dai (Crypto++ 3.1) 105 | credits Rich Schroeppel (rcs@cs.arizona.edu), V 5.1 does not!?} 106 | 107 | 108 | {$i STD.INC} 109 | 110 | {$ifdef BIT64} 111 | {$ifndef PurePascal} 112 | {$define PurePascal} 113 | {$endif} 114 | {$endif} 115 | 116 | uses 117 | BTypes,Hash; 118 | 119 | 120 | procedure SHA1Init(var Context: THashContext); 121 | {-initialize context} 122 | 123 | procedure SHA1Update(var Context: THashContext; Msg: pointer; Len: word); 124 | {-update context with Msg data} 125 | 126 | procedure SHA1UpdateXL(var Context: THashContext; Msg: pointer; Len: longint); 127 | {-update context with Msg data} 128 | 129 | procedure SHA1Final(var Context: THashContext; var Digest: TSHA1Digest); 130 | {-finalize SHA1 calculation, clear context} 131 | 132 | procedure SHA1FinalEx(var Context: THashContext; var Digest: THashDigest); 133 | {-finalize SHA1 calculation, clear context} 134 | 135 | procedure SHA1FinalBitsEx(var Context: THashContext; var Digest: THashDigest; BData: byte; bitlen: integer); 136 | {-finalize SHA1 calculation with bitlen bits from BData (big-endian), clear context} 137 | 138 | procedure SHA1FinalBits(var Context: THashContext; var Digest: TSHA1Digest; BData: byte; bitlen: integer); 139 | {-finalize SHA1 calculation with bitlen bits from BData (big-endian), clear context} 140 | 141 | function SHA1SelfTest: boolean; 142 | {-self test SHA1: compare with known value} 143 | 144 | procedure SHA1Full(var Digest: TSHA1Digest; Msg: pointer; Len: word); 145 | {-SHA1 of Msg with init/update/final} 146 | 147 | procedure SHA1FullXL(var Digest: TSHA1Digest; Msg: pointer; Len: longint); 148 | {-SHA1 of Msg with init/update/final} 149 | 150 | procedure SHA1File({$ifdef CONST} const {$endif} fname: Str255; 151 | var Digest: TSHA1Digest; var buf; bsize: word; var Err: word); 152 | {-SHA1 of file, buf: buffer with at least bsize bytes} 153 | 154 | 155 | implementation 156 | 157 | {$ifdef BIT16} 158 | {$F-} 159 | {$endif} 160 | 161 | const 162 | SHA1_BlockLen = 64; 163 | 164 | const {round constants} 165 | K1 = longint($5A827999); {round 00..19} 166 | K2 = longint($6ED9EBA1); {round 20..39} 167 | K3 = longint($8F1BBCDC); {round 40..59} 168 | K4 = longint($CA62C1D6); {round 60..79} 169 | 170 | 171 | {Internal types} 172 | type 173 | TWorkBuf = array[0..79] of longint; 174 | 175 | {1.3.14.3.2.26} 176 | {iso(1) identified-organization(3) oiw(14) secsig(3) algorithms(2) hashAlgorithmIdentifier(26)} 177 | const 178 | SHA1_OID : TOID_Vec = (1,3,14,3,2,26,-1,-1,-1,-1,-1); {Len=6} 179 | 180 | {$ifndef VER5X} 181 | const 182 | SHA1_Desc: THashDesc = ( 183 | HSig : C_HashSig; 184 | HDSize : sizeof(THashDesc); 185 | HDVersion : C_HashVers; 186 | HBlockLen : SHA1_BlockLen; 187 | HDigestlen: sizeof(TSHA1Digest); 188 | {$ifdef FPC_ProcVar} 189 | HInit : @SHA1Init; 190 | HFinal : @SHA1FinalEx; 191 | HUpdateXL : @SHA1UpdateXL; 192 | {$else} 193 | HInit : SHA1Init; 194 | HFinal : SHA1FinalEx; 195 | HUpdateXL : SHA1UpdateXL; 196 | {$endif} 197 | HAlgNum : longint(_SHA1); 198 | HName : 'SHA1'; 199 | HPtrOID : @SHA1_OID; 200 | HLenOID : 6; 201 | HFill : 0; 202 | {$ifdef FPC_ProcVar} 203 | HFinalBit : @SHA1FinalBitsEx; 204 | {$else} 205 | HFinalBit : SHA1FinalBitsEx; 206 | {$endif} 207 | HReserved : (0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0) 208 | ); 209 | {$else} 210 | var 211 | SHA1_Desc: THashDesc; 212 | {$endif} 213 | 214 | 215 | 216 | {$ifndef BIT16} 217 | 218 | {$ifdef PurePascal} 219 | {---------------------------------------------------------------------------} 220 | procedure UpdateLen(var whi, wlo: longint; BLen: longint); 221 | {-Add BLen to 64 bit value (wlo, whi)} 222 | var 223 | tmp: int64; 224 | begin 225 | tmp := int64(cardinal(wlo))+Blen; 226 | wlo := longint(tmp and $FFFFFFFF); 227 | inc(whi,longint(tmp shr 32)); 228 | end; 229 | 230 | {---------------------------------------------------------------------------} 231 | function RB(A: longint): longint; 232 | {-reverse byte order in longint} 233 | begin 234 | RB := ((A and $FF) shl 24) or ((A and $FF00) shl 8) or ((A and $FF0000) shr 8) or ((A and longint($FF000000)) shr 24); 235 | end; 236 | 237 | {---------------------------------------------------------------------------} 238 | procedure ExpandMessageBlocks(var W: TWorkBuf; var Buf: THashBuffer); 239 | {-Calculate "expanded message blocks"} 240 | var 241 | i,T: longint; 242 | begin 243 | {Part 1: Transfer buffer with little -> big endian conversion} 244 | for i:= 0 to 15 do W[i]:= RB(THashBuf32(Buf)[i]); 245 | {Part 2: Calculate remaining "expanded message blocks"} 246 | for i:= 16 to 79 do begin 247 | T := W[i-3] xor W[i-8] xor W[i-14] xor W[i-16]; 248 | W[i] := (T shl 1) or (T shr 31); 249 | end; 250 | end; 251 | 252 | {$else} 253 | {---------------------------------------------------------------------------} 254 | procedure UpdateLen(var whi, wlo: longint; BLen: longint); 255 | {-Add BLen to 64 bit value (wlo, whi)} 256 | begin 257 | asm 258 | mov edx, [wlo] 259 | mov ecx, [whi] 260 | mov eax, [Blen] 261 | add [edx], eax 262 | adc dword ptr [ecx], 0 263 | end; 264 | end; 265 | 266 | {---------------------------------------------------------------------------} 267 | function RB(A: longint): longint; assembler; 268 | {-reverse byte order in longint} 269 | asm 270 | {$ifdef LoadArgs} 271 | mov eax,[A] 272 | {$endif} 273 | xchg al,ah 274 | rol eax,16 275 | xchg al,ah 276 | end; 277 | 278 | {---------------------------------------------------------------------------} 279 | procedure ExpandMessageBlocks(var W: TWorkBuf; var Buf: THashBuffer); assembler; 280 | {-Calculate "expanded message blocks"} 281 | asm 282 | {$ifdef LoadArgs} 283 | mov edx,Buf 284 | mov ecx,W {load W before push ebx to avoid VP crash} 285 | push ebx {if compiling with no ASM stack frames} 286 | mov ebx,ecx 287 | {$else} 288 | push ebx 289 | mov ebx,eax 290 | {$endif} 291 | {part1: W[i]:= RB(TW32Buf(Buf)[i])} 292 | mov ecx,16 293 | @@1: mov eax,[edx] 294 | xchg al,ah 295 | rol eax,16 296 | xchg al,ah 297 | mov [ebx],eax 298 | add ebx,4 299 | add edx,4 300 | dec ecx 301 | jnz @@1 302 | {part2: W[i]:= LRot_1(W[i-3] xor W[i-8] xor W[i-14] xor W[i-16]);} 303 | mov ecx,64 304 | @@2: mov eax,[ebx- 3*4] 305 | xor eax,[ebx- 8*4] 306 | xor eax,[ebx-14*4] 307 | xor eax,[ebx-16*4] 308 | rol eax,1 309 | mov [ebx],eax 310 | add ebx,4 311 | dec ecx 312 | jnz @@2 313 | pop ebx 314 | end; 315 | {$endif} 316 | 317 | 318 | {---------------------------------------------------------------------------} 319 | procedure SHA1Compress(var Data: THashContext); 320 | {-Actual hashing function} 321 | var 322 | i: integer; 323 | A, B, C, D, E: longint; 324 | W: TWorkBuf; 325 | begin 326 | 327 | ExpandMessageBlocks(W, Data.Buffer); 328 | 329 | A := Data.Hash[0]; 330 | B := Data.Hash[1]; 331 | C := Data.Hash[2]; 332 | D := Data.Hash[3]; 333 | E := Data.Hash[4]; 334 | 335 | {SHA1 compression function} 336 | {Partial unroll for more speed, full unroll is only slightly faster} 337 | {BIT32: rotateleft via inline} 338 | i := 0; 339 | while i<20 do begin 340 | inc(E, (A shl 5 or A shr 27) + (D xor (B and (C xor D))) + W[i ] + K1); B := B shr 2 or B shl 30; 341 | inc(D, (E shl 5 or E shr 27) + (C xor (A and (B xor C))) + W[i+1] + K1); A := A shr 2 or A shl 30; 342 | inc(C, (D shl 5 or D shr 27) + (B xor (E and (A xor B))) + W[i+2] + K1); E := E shr 2 or E shl 30; 343 | inc(B, (C shl 5 or C shr 27) + (A xor (D and (E xor A))) + W[i+3] + K1); D := D shr 2 or D shl 30; 344 | inc(A, (B shl 5 or B shr 27) + (E xor (C and (D xor E))) + W[i+4] + K1); C := C shr 2 or C shl 30; 345 | inc(i,5); 346 | end; 347 | while i<40 do begin 348 | inc(E, (A shl 5 or A shr 27) + (D xor B xor C) + W[i ] + K2); B := B shr 2 or B shl 30; 349 | inc(D, (E shl 5 or E shr 27) + (C xor A xor B) + W[i+1] + K2); A := A shr 2 or A shl 30; 350 | inc(C, (D shl 5 or D shr 27) + (B xor E xor A) + W[i+2] + K2); E := E shr 2 or E shl 30; 351 | inc(B, (C shl 5 or C shr 27) + (A xor D xor E) + W[i+3] + K2); D := D shr 2 or D shl 30; 352 | inc(A, (B shl 5 or B shr 27) + (E xor C xor D) + W[i+4] + K2); C := C shr 2 or C shl 30; 353 | inc(i,5); 354 | end; 355 | while i<60 do begin 356 | inc(E, (A shl 5 or A shr 27) + ((B and C) or (D and (B or C))) + W[i ] + K3); B := B shr 2 or B shl 30; 357 | inc(D, (E shl 5 or E shr 27) + ((A and B) or (C and (A or B))) + W[i+1] + K3); A := A shr 2 or A shl 30; 358 | inc(C, (D shl 5 or D shr 27) + ((E and A) or (B and (E or A))) + W[i+2] + K3); E := E shr 2 or E shl 30; 359 | inc(B, (C shl 5 or C shr 27) + ((D and E) or (A and (D or E))) + W[i+3] + K3); D := D shr 2 or D shl 30; 360 | inc(A, (B shl 5 or B shr 27) + ((C and D) or (E and (C or D))) + W[i+4] + K3); C := C shr 2 or C shl 30; 361 | inc(i,5); 362 | end; 363 | while i<80 do begin 364 | inc(E, (A shl 5 or A shr 27) + (D xor B xor C) + W[i ] + K4); B := B shr 2 or B shl 30; 365 | inc(D, (E shl 5 or E shr 27) + (C xor A xor B) + W[i+1] + K4); A := A shr 2 or A shl 30; 366 | inc(C, (D shl 5 or D shr 27) + (B xor E xor A) + W[i+2] + K4); E := E shr 2 or E shl 30; 367 | inc(B, (C shl 5 or C shr 27) + (A xor D xor E) + W[i+3] + K4); D := D shr 2 or D shl 30; 368 | inc(A, (B shl 5 or B shr 27) + (E xor C xor D) + W[i+4] + K4); C := C shr 2 or C shl 30; 369 | inc(i,5); 370 | end; 371 | 372 | {Calculate new working hash} 373 | inc(Data.Hash[0], A); 374 | inc(Data.Hash[1], B); 375 | inc(Data.Hash[2], C); 376 | inc(Data.Hash[3], D); 377 | inc(Data.Hash[4], E); 378 | end; 379 | 380 | 381 | 382 | {$else} 383 | 384 | 385 | {$ifdef BASM16} 386 | 387 | {TP6-7/Delphi1 for 386+} 388 | 389 | {---------------------------------------------------------------------------} 390 | procedure UpdateLen(var whi, wlo: longint; BLen: longint); assembler; 391 | {-Add BLen to 64 bit value (wlo, whi)} 392 | asm 393 | les di,[wlo] 394 | db $66; mov ax,word ptr [BLen] 395 | db $66; sub dx,dx 396 | db $66; add es:[di],ax 397 | les di,[whi] 398 | db $66; adc es:[di],dx 399 | end; 400 | 401 | 402 | {---------------------------------------------------------------------------} 403 | function LRot_5(x: longint): longint; 404 | {-Rotate left 5} 405 | inline( 406 | $66/$58/ {pop eax } 407 | $66/$C1/$C0/$05/ {rol eax,5 } 408 | $66/$8B/$D0/ {mov edx,eax} 409 | $66/$C1/$EA/$10); {shr edx,16 } 410 | 411 | 412 | {---------------------------------------------------------------------------} 413 | function RB(A: longint): longint; 414 | {-reverse byte order in longint} 415 | inline( 416 | $58/ {pop ax } 417 | $5A/ {pop dx } 418 | $86/$C6/ {xchg dh,al } 419 | $86/$E2); {xchg dl,ah } 420 | 421 | 422 | {---------------------------------------------------------------------------} 423 | procedure ExpandMessageBlocks(var W: TWorkBuf; var Buf: THashBuffer); assembler; 424 | {-Calculate "expanded message blocks"} 425 | asm 426 | push ds 427 | {part 1: W[i]:= RB(TW32Buf(Buf)[i])} 428 | les di,[Buf] 429 | lds si,[W] 430 | mov cx,16 431 | @@1: db $66; mov ax,es:[di] 432 | xchg al,ah 433 | db $66; rol ax,16 434 | xchg al,ah 435 | db $66; mov [si],ax 436 | add si,4 437 | add di,4 438 | dec cx 439 | jnz @@1 440 | {part 2: W[i]:= LRot_1(W[i-3] xor W[i-8] xor W[i-14] xor W[i-16]);} 441 | mov cx,64 442 | @@2: db $66; mov ax,[si- 3*4] 443 | db $66; xor ax,[si- 8*4] 444 | db $66; xor ax,[si-14*4] 445 | db $66; xor ax,[si-16*4] 446 | db $66; rol ax,1 447 | db $66; mov [si],ax 448 | add si,4 449 | dec cx 450 | jnz @@2 451 | pop ds 452 | end; 453 | 454 | {---------------------------------------------------------------------------} 455 | procedure SHA1Compress(var Data: THashContext); 456 | {-Actual hashing function} 457 | var 458 | i: integer; 459 | A, B, C, D, E: longint; 460 | W: TWorkBuf; 461 | begin 462 | ExpandMessageBlocks(W, Data.Buffer); 463 | {Assign old working hash to variables A..E} 464 | A := Data.Hash[0]; 465 | B := Data.Hash[1]; 466 | C := Data.Hash[2]; 467 | D := Data.Hash[3]; 468 | E := Data.Hash[4]; 469 | 470 | {SHA1 compression function} 471 | {Partial unroll for more speed, full unroll only marginally faster} 472 | {Two INCs, LRot_30 via BASM} 473 | i := 0; 474 | while i<20 do begin 475 | inc(E,LRot_5(A)); inc(E,(D xor (B and (C xor D))) + W[i ] + K1); asm db $66; rol word[B],30 end; 476 | inc(D,LRot_5(E)); inc(D,(C xor (A and (B xor C))) + W[i+1] + K1); asm db $66; rol word[A],30 end; 477 | inc(C,LRot_5(D)); inc(C,(B xor (E and (A xor B))) + W[i+2] + K1); asm db $66; rol word[E],30 end; 478 | inc(B,LRot_5(C)); inc(B,(A xor (D and (E xor A))) + W[i+3] + K1); asm db $66; rol word[D],30 end; 479 | inc(A,LRot_5(B)); inc(A,(E xor (C and (D xor E))) + W[i+4] + K1); asm db $66; rol word[C],30 end; 480 | inc(i,5); 481 | end; 482 | while i<40 do begin 483 | inc(E,LRot_5(A)); inc(E,(B xor C xor D) + W[i ] + K2); asm db $66; rol word[B],30 end; 484 | inc(D,LRot_5(E)); inc(D,(A xor B xor C) + W[i+1] + K2); asm db $66; rol word[A],30 end; 485 | inc(C,LRot_5(D)); inc(C,(E xor A xor B) + W[i+2] + K2); asm db $66; rol word[E],30 end; 486 | inc(B,LRot_5(C)); inc(B,(D xor E xor A) + W[i+3] + K2); asm db $66; rol word[D],30 end; 487 | inc(A,LRot_5(B)); inc(A,(C xor D xor E) + W[i+4] + K2); asm db $66; rol word[C],30 end; 488 | inc(i,5); 489 | end; 490 | while i<60 do begin 491 | inc(E,LRot_5(A)); inc(E,((B and C) or (D and (B or C))) + W[i ] + K3); asm db $66; rol word[B],30 end; 492 | inc(D,LRot_5(E)); inc(D,((A and B) or (C and (A or B))) + W[i+1] + K3); asm db $66; rol word[A],30 end; 493 | inc(C,LRot_5(D)); inc(C,((E and A) or (B and (E or A))) + W[i+2] + K3); asm db $66; rol word[E],30 end; 494 | inc(B,LRot_5(C)); inc(B,((D and E) or (A and (D or E))) + W[i+3] + K3); asm db $66; rol word[D],30 end; 495 | inc(A,LRot_5(B)); inc(A,((C and D) or (E and (C or D))) + W[i+4] + K3); asm db $66; rol word[C],30 end; 496 | inc(i,5); 497 | end; 498 | while i<80 do begin 499 | inc(E,LRot_5(A)); inc(E,(B xor C xor D) + W[i ] + K4); asm db $66; rol word[B],30 end; 500 | inc(D,LRot_5(E)); inc(D,(A xor B xor C) + W[i+1] + K4); asm db $66; rol word[A],30 end; 501 | inc(C,LRot_5(D)); inc(C,(E xor A xor B) + W[i+2] + K4); asm db $66; rol word[E],30 end; 502 | inc(B,LRot_5(C)); inc(B,(D xor E xor A) + W[i+3] + K4); asm db $66; rol word[D],30 end; 503 | inc(A,LRot_5(B)); inc(A,(C xor D xor E) + W[i+4] + K4); asm db $66; rol word[C],30 end; 504 | inc(i,5); 505 | end; 506 | 507 | {Calculate new working hash} 508 | inc(Data.Hash[0], A); 509 | inc(Data.Hash[1], B); 510 | inc(Data.Hash[2], C); 511 | inc(Data.Hash[3], D); 512 | inc(Data.Hash[4], E); 513 | 514 | end; 515 | 516 | 517 | {$else} 518 | 519 | {TP5/5.5} 520 | 521 | {---------------------------------------------------------------------------} 522 | procedure UpdateLen(var whi, wlo: longint; BLen: longint); 523 | {-Add BLen to 64 bit value (wlo, whi)} 524 | inline( 525 | $58/ {pop ax } 526 | $5A/ {pop dx } 527 | $5B/ {pop bx } 528 | $07/ {pop es } 529 | $26/$01/$07/ {add es:[bx],ax } 530 | $26/$11/$57/$02/ {adc es:[bx+02],dx} 531 | $5B/ {pop bx } 532 | $07/ {pop es } 533 | $26/$83/$17/$00/ {adc es:[bx],0 } 534 | $26/$83/$57/$02/$00);{adc es:[bx+02],0 } 535 | 536 | 537 | {---------------------------------------------------------------------------} 538 | function RB(A: longint): longint; 539 | {-reverse byte order in longint} 540 | inline( 541 | $58/ { pop ax } 542 | $5A/ { pop dx } 543 | $86/$C6/ { xchg dh,al} 544 | $86/$E2); { xchg dl,ah} 545 | 546 | 547 | {---------------------------------------------------------------------------} 548 | function LRot_1(x: longint): longint; 549 | {-Rotate left 1} 550 | inline( 551 | $58/ { pop ax } 552 | $5A/ { pop dx } 553 | $2B/$C9/ { sub cx,cx} 554 | $D1/$D0/ { rcl ax,1 } 555 | $D1/$D2/ { rcl dx,1 } 556 | $13/$C1); { adc ax,cx} 557 | 558 | 559 | {---------------------------------------------------------------------------} 560 | function LRot_5(x: longint): longint; 561 | {-Rotate left 5} 562 | inline( 563 | $58/ { pop ax } 564 | $5A/ { pop dx } 565 | $2B/$C9/ { sub cx,cx} 566 | $D1/$D0/ { rcl ax,1 } 567 | $D1/$D2/ { rcl dx,1 } 568 | $13/$C1/ { adc ax,cx} 569 | $D1/$D0/ { rcl ax,1 } 570 | $D1/$D2/ { rcl dx,1 } 571 | $13/$C1/ { adc ax,cx} 572 | $D1/$D0/ { rcl ax,1 } 573 | $D1/$D2/ { rcl dx,1 } 574 | $13/$C1/ { adc ax,cx} 575 | $D1/$D0/ { rcl ax,1 } 576 | $D1/$D2/ { rcl dx,1 } 577 | $13/$C1/ { adc ax,cx} 578 | $D1/$D0/ { rcl ax,1 } 579 | $D1/$D2/ { rcl dx,1 } 580 | $13/$C1); { adc ax,cx} 581 | 582 | 583 | {---------------------------------------------------------------------------} 584 | function LRot_30(x: longint): longint; 585 | {-Rotate left 30 = rot right 2} 586 | inline( 587 | $58/ { pop ax } 588 | $5A/ { pop dx } 589 | $8B/$CA/ { mov cx,dx} 590 | $D1/$E9/ { shr cx,1 } 591 | $D1/$D8/ { rcr ax,1 } 592 | $D1/$DA/ { rcr dx,1 } 593 | $8B/$CA/ { mov cx,dx} 594 | $D1/$E9/ { shr cx,1 } 595 | $D1/$D8/ { rcr ax,1 } 596 | $D1/$DA); { rcr dx,1 } 597 | 598 | 599 | {---------------------------------------------------------------------------} 600 | procedure ExpandMessageBlocks(var W: TWorkBuf; var Buf: THashBuffer); 601 | {-Calculate "expanded message blocks"} 602 | var 603 | i: integer; 604 | begin 605 | {Part 1: Transfer buffer with little -> big endian conversion} 606 | for i:= 0 to 15 do W[i]:= RB(THashBuf32(Buf)[i]); 607 | {Part 2: Calculate remaining "expanded message blocks"} 608 | for i:= 16 to 79 do W[i]:= LRot_1(W[i-3] xor W[i-8] xor W[i-14] xor W[i-16]); 609 | end; 610 | 611 | 612 | {---------------------------------------------------------------------------} 613 | procedure SHA1Compress(var Data: THashContext); 614 | {-Actual hashing function} 615 | var 616 | i: integer; 617 | A, B, C, D, E: longint; 618 | W: TWorkBuf; 619 | begin 620 | ExpandMessageBlocks(W, Data.Buffer); 621 | 622 | {Assign old working hash to variables A..E} 623 | A := Data.Hash[0]; 624 | B := Data.Hash[1]; 625 | C := Data.Hash[2]; 626 | D := Data.Hash[3]; 627 | E := Data.Hash[4]; 628 | 629 | {SHA1 compression function} 630 | {Partial unroll for more speed, full unroll only marginally faster} 631 | {BIT16: rotateleft via function call} 632 | i := 0; 633 | while i<20 do begin 634 | inc(E,LRot_5(A) + (D xor (B and (C xor D))) + W[i ] + K1); B := LRot_30(B); 635 | inc(D,LRot_5(E) + (C xor (A and (B xor C))) + W[i+1] + K1); A := LRot_30(A); 636 | inc(C,LRot_5(D) + (B xor (E and (A xor B))) + W[i+2] + K1); E := LRot_30(E); 637 | inc(B,LRot_5(C) + (A xor (D and (E xor A))) + W[i+3] + K1); D := LRot_30(D); 638 | inc(A,LRot_5(B) + (E xor (C and (D xor E))) + W[i+4] + K1); C := LRot_30(C); 639 | inc(i,5); 640 | end; 641 | while i<40 do begin 642 | inc(E,LRot_5(A) + (B xor C xor D) + W[i ] + K2); B := LRot_30(B); 643 | inc(D,LRot_5(E) + (A xor B xor C) + W[i+1] + K2); A := LRot_30(A); 644 | inc(C,LRot_5(D) + (E xor A xor B) + W[i+2] + K2); E := LRot_30(E); 645 | inc(B,LRot_5(C) + (D xor E xor A) + W[i+3] + K2); D := LRot_30(D); 646 | inc(A,LRot_5(B) + (C xor D xor E) + W[i+4] + K2); C := LRot_30(C); 647 | inc(i,5); 648 | end; 649 | while i<60 do begin 650 | inc(E,LRot_5(A) + ((B and C) or (D and (B or C))) + W[i ] + K3); B := LRot_30(B); 651 | inc(D,LRot_5(E) + ((A and B) or (C and (A or B))) + W[i+1] + K3); A := LRot_30(A); 652 | inc(C,LRot_5(D) + ((E and A) or (B and (E or A))) + W[i+2] + K3); E := LRot_30(E); 653 | inc(B,LRot_5(C) + ((D and E) or (A and (D or E))) + W[i+3] + K3); D := LRot_30(D); 654 | inc(A,LRot_5(B) + ((C and D) or (E and (C or D))) + W[i+4] + K3); C := LRot_30(C); 655 | inc(i,5); 656 | end; 657 | while i<80 do begin 658 | inc(E,LRot_5(A) + (B xor C xor D) + W[i ] + K4); B := LRot_30(B); 659 | inc(D,LRot_5(E) + (A xor B xor C) + W[i+1] + K4); A := LRot_30(A); 660 | inc(C,LRot_5(D) + (E xor A xor B) + W[i+2] + K4); E := LRot_30(E); 661 | inc(B,LRot_5(C) + (D xor E xor A) + W[i+3] + K4); D := LRot_30(D); 662 | inc(A,LRot_5(B) + (C xor D xor E) + W[i+4] + K4); C := LRot_30(C); 663 | inc(i,5); 664 | end; 665 | 666 | {Calculate new working hash} 667 | inc(Data.Hash[0], A); 668 | inc(Data.Hash[1], B); 669 | inc(Data.Hash[2], C); 670 | inc(Data.Hash[3], D); 671 | inc(Data.Hash[4], E); 672 | 673 | end; 674 | 675 | {$endif BASM16} 676 | 677 | {$endif BIT16} 678 | 679 | 680 | 681 | {---------------------------------------------------------------------------} 682 | procedure SHA1Init(var Context: THashContext); 683 | {-initialize context} 684 | begin 685 | {Clear context, buffer=0!!} 686 | fillchar(Context,sizeof(Context),0); 687 | with Context do begin 688 | Hash[0] := longint($67452301); 689 | Hash[1] := longint($EFCDAB89); 690 | Hash[2] := longint($98BADCFE); 691 | Hash[3] := longint($10325476); 692 | Hash[4] := longint($C3D2E1F0); 693 | end; 694 | end; 695 | 696 | 697 | {---------------------------------------------------------------------------} 698 | procedure SHA1UpdateXL(var Context: THashContext; Msg: pointer; Len: longint); 699 | {-update context with Msg data} 700 | var 701 | i: integer; 702 | begin 703 | {Update message bit length} 704 | if Len<=$1FFFFFFF then UpdateLen(Context.MLen[1], Context.MLen[0], Len shl 3) 705 | else begin 706 | for i:=1 to 8 do UpdateLen(Context.MLen[1], Context.MLen[0], Len) 707 | end; 708 | while Len > 0 do begin 709 | {fill block with msg data} 710 | Context.Buffer[Context.Index]:= pByte(Msg)^; 711 | inc(Ptr2Inc(Msg)); 712 | inc(Context.Index); 713 | dec(Len); 714 | if Context.Index=SHA1_BlockLen then begin 715 | {If 512 bit transferred, compress a block} 716 | Context.Index:= 0; 717 | SHA1Compress(Context); 718 | while Len>=SHA1_BlockLen do begin 719 | move(Msg^,Context.Buffer,SHA1_BlockLen); 720 | SHA1Compress(Context); 721 | inc(Ptr2Inc(Msg),SHA1_BlockLen); 722 | dec(Len,SHA1_BlockLen); 723 | end; 724 | end; 725 | end; 726 | end; 727 | 728 | 729 | {---------------------------------------------------------------------------} 730 | procedure SHA1Update(var Context: THashContext; Msg: pointer; Len: word); 731 | {-update context with Msg data} 732 | begin 733 | SHA1UpdateXL(Context, Msg, Len); 734 | end; 735 | 736 | 737 | 738 | {---------------------------------------------------------------------------} 739 | procedure SHA1FinalBitsEx(var Context: THashContext; var Digest: THashDigest; BData: byte; bitlen: integer); 740 | {-finalize SHA1 calculation with bitlen bits from BData (big-endian), clear context} 741 | var 742 | i: integer; 743 | begin 744 | {Message padding} 745 | {append bits from BData and a single '1' bit} 746 | if (bitlen>0) and (bitlen<=7) then begin 747 | Context.Buffer[Context.Index]:= (BData and BitAPI_Mask[bitlen]) or BitAPI_PBit[bitlen]; 748 | UpdateLen(Context.MLen[1], Context.MLen[0], bitlen); 749 | end 750 | else Context.Buffer[Context.Index]:= $80; 751 | 752 | for i:=Context.Index+1 to 63 do Context.Buffer[i] := 0; 753 | {2. Compress if more than 448 bits, (no room for 64 bit length} 754 | if Context.Index>= 56 then begin 755 | SHA1Compress(Context); 756 | fillchar(Context.Buffer,56,0); 757 | end; 758 | {Write 64 bit msg length into the last bits of the last block} 759 | {(in big endian format) and do a final compress} 760 | THashBuf32(Context.Buffer)[14] := RB(Context.MLen[1]); 761 | THashBuf32(Context.Buffer)[15] := RB(Context.MLen[0]); 762 | SHA1Compress(Context); 763 | {Hash->Digest to little endian format} 764 | fillchar(Digest, sizeof(Digest), 0); 765 | for i:=0 to 4 do THashDig32(Digest)[i]:= RB(Context.Hash[i]); 766 | {Clear context} 767 | fillchar(Context,sizeof(Context),0); 768 | end; 769 | 770 | 771 | {---------------------------------------------------------------------------} 772 | procedure SHA1FinalBits(var Context: THashContext; var Digest: TSHA1Digest; BData: byte; bitlen: integer); 773 | {-finalize SHA1 calculation with bitlen bits from BData (big-endian), clear context} 774 | var 775 | tmp: THashDigest; 776 | begin 777 | SHA1FinalBitsEx(Context, tmp, BData, bitlen); 778 | move(tmp, Digest, sizeof(Digest)); 779 | end; 780 | 781 | 782 | {---------------------------------------------------------------------------} 783 | procedure SHA1FinalEx(var Context: THashContext; var Digest: THashDigest); 784 | {-finalize SHA1 calculation, clear context} 785 | begin 786 | SHA1FinalBitsEx(Context,Digest,0,0); 787 | end; 788 | 789 | 790 | {---------------------------------------------------------------------------} 791 | procedure SHA1Final(var Context: THashContext; var Digest: TSHA1Digest); 792 | {-finalize SHA1 calculation, clear context} 793 | var 794 | tmp: THashDigest; 795 | begin 796 | SHA1FinalBitsEx(Context, tmp, 0, 0); 797 | move(tmp, Digest, sizeof(Digest)); 798 | end; 799 | 800 | 801 | {---------------------------------------------------------------------------} 802 | function SHA1SelfTest: boolean; 803 | {-self test SHA1: compare with known value} 804 | const 805 | s1: string[ 3] = 'abc'; 806 | s2: string[56] = 'abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq'; 807 | D1: TSHA1Digest= ($a9,$99,$3e,$36,$47,$06,$81,$6a,$ba,$3e,$25,$71,$78,$50,$c2,$6c,$9c,$d0,$d8,$9d); 808 | D2: TSHA1Digest= ($84,$98,$3E,$44,$1C,$3B,$D2,$6E,$BA,$AE,$4A,$A1,$F9,$51,$29,$E5,$E5,$46,$70,$F1); 809 | D3: TSHA1Digest= ($bb,$6b,$3e,$18,$f0,$11,$5b,$57,$92,$52,$41,$67,$6f,$5b,$1a,$e8,$87,$47,$b0,$8a); 810 | D4: TSHA1Digest= ($98,$23,$2a,$15,$34,$53,$14,$9a,$f8,$d5,$2a,$61,$50,$3a,$50,$74,$b8,$59,$70,$e8); 811 | var 812 | Context: THashContext; 813 | Digest : TSHA1Digest; 814 | 815 | function SingleTest(s: Str127; TDig: TSHA1Digest): boolean; 816 | {-do a single test, const not allowed for VER<7} 817 | { Two sub tests: 1. whole string, 2. one update per char} 818 | var 819 | i: integer; 820 | begin 821 | SingleTest := false; 822 | {1. Hash complete string} 823 | SHA1Full(Digest, @s[1],length(s)); 824 | {Compare with known value} 825 | if not HashSameDigest(@SHA1_Desc, PHashDigest(@Digest), PHashDigest(@TDig)) then exit; 826 | {2. one update call for all chars} 827 | SHA1Init(Context); 828 | for i:=1 to length(s) do SHA1Update(Context,@s[i],1); 829 | SHA1Final(Context,Digest); 830 | {Compare with known value} 831 | if not HashSameDigest(@SHA1_Desc, PHashDigest(@Digest), PHashDigest(@TDig)) then exit; 832 | SingleTest := true; 833 | end; 834 | 835 | begin 836 | SHA1SelfTest := false; 837 | {1 Zero bit from NESSIE test vectors} 838 | SHA1Init(Context); 839 | SHA1FinalBits(Context,Digest,0,1); 840 | if not HashSameDigest(@SHA1_Desc, PHashDigest(@Digest), PHashDigest(@D3)) then exit; 841 | {4 hightest bits of $50, D4 calculated with program shatest from RFC 4634} 842 | SHA1Init(Context); 843 | SHA1FinalBits(Context,Digest,$50,4); 844 | if not HashSameDigest(@SHA1_Desc, PHashDigest(@Digest), PHashDigest(@D4)) then exit; 845 | {strings from SHA1 document} 846 | SHA1SelfTest := SingleTest(s1, D1) and SingleTest(s2, D2) 847 | end; 848 | 849 | 850 | {---------------------------------------------------------------------------} 851 | procedure SHA1FullXL(var Digest: TSHA1Digest; Msg: pointer; Len: longint); 852 | {-SHA1 of Msg with init/update/final} 853 | var 854 | Context: THashContext; 855 | begin 856 | SHA1Init(Context); 857 | SHA1UpdateXL(Context, Msg, Len); 858 | SHA1Final(Context, Digest); 859 | end; 860 | 861 | 862 | {---------------------------------------------------------------------------} 863 | procedure SHA1Full(var Digest: TSHA1Digest; Msg: pointer; Len: word); 864 | {-SHA1 of Msg with init/update/final} 865 | begin 866 | SHA1FullXL(Digest, Msg, Len); 867 | end; 868 | 869 | 870 | {---------------------------------------------------------------------------} 871 | procedure SHA1File({$ifdef CONST} const {$endif} fname: Str255; 872 | var Digest: TSHA1Digest; var buf; bsize: word; var Err: word); 873 | {-SHA1 of file, buf: buffer with at least bsize bytes} 874 | var 875 | tmp: THashDigest; 876 | begin 877 | HashFile(fname, @SHA1_Desc, tmp, buf, bsize, Err); 878 | move(tmp, Digest, sizeof(Digest)); 879 | end; 880 | 881 | 882 | begin 883 | {$ifdef VER5X} 884 | fillchar(SHA1_Desc, sizeof(SHA1_Desc), 0); 885 | with SHA1_Desc do begin 886 | HSig := C_HashSig; 887 | HDSize := sizeof(THashDesc); 888 | HDVersion := C_HashVers; 889 | HBlockLen := SHA1_BlockLen; 890 | HDigestlen:= sizeof(TSHA1Digest); 891 | HInit := SHA1Init; 892 | HFinal := SHA1FinalEx; 893 | HUpdateXL := SHA1UpdateXL; 894 | HAlgNum := longint(_SHA1); 895 | HName := 'SHA1'; 896 | HPtrOID := @SHA1_OID; 897 | HLenOID := 6; 898 | HFinalBit := SHA1FinalBitsEx; 899 | end; 900 | {$endif} 901 | RegisterHash(_SHA1, @SHA1_Desc); 902 | end. 903 | -------------------------------------------------------------------------------- /src/we/std.inc: -------------------------------------------------------------------------------- 1 | (************************************************************************* 2 | 3 | DESCRIPTION : Standard definitions and options 4 | 5 | REQUIREMENTS : TP5-7, D1-D7/D9-D12/D14-D25, FPC, VP, (TPW1.0/1.5,BCB3/4) 6 | 7 | Version Date Author Modification 8 | ------- -------- ------- ------------------------------------------ 9 | 1.00 05.10.03 W.Ehrhardt Initial version 10 | 1.01 05.10.03 we X_OPT, removed TP4 11 | 1.02 30.10.03 we WINCRT 12 | 1.03 09.12.03 we {$R+,S+} {$ifdef debug} 13 | 1.04 26.12.03 we VP: {&Optimise+,SmartLink+,Speed+} ifndef debug 14 | 1.05 28.12.03 we DELPHI = Delphi32 (no Delphi 1!) 15 | 1.06 12.04.04 we Delphi 7 16 | 1.07 26.09.04 we Record starting values of important options 17 | 1.08 10.10.04 we RESULT for Result pseudo variable 18 | 1.09 02.01.05 we BIT16: default $F- 19 | 1.10 26.02.05 we StrictLong 20 | 1.11 05.05.05 we D9 aka Delphi 2005 21 | 1.12 22.05.05 we StrictLong for FPC 2.0 22 | 1.13 27.05.05 we {$goto on} for FPC 23 | 1.14 27.05.05 we moved {$goto on} to default settings 24 | 1.15 29.05.05 we HAS_INT64, HAS_MSG, _STD_INC_ 25 | 1.16 06.08.05 we J_OPT, N_OPT, HAS_INLINE 26 | 1.17 17.08.05 we HAS_ASSERT 27 | 1.18 08.11.05 we APPCONS, partial TMT,TPW15 support 28 | 1.19 20.11.05 we Default option {$B-} 29 | 1.20 08.01.06 we ABSTRACT/DEFAULT 30 | 1.21 08.02.06 we Fix Scanhelp quirk 31 | 1.22 11.02.06 we VER5X 32 | 1.23 15.04.06 we HAS_XTYPES 33 | 1.24 08.05.06 we D10 aka Delphi 2006 34 | 1.25 25.05.06 we Define RESULT if FPC_OBJFPC is defined 35 | 1.26 08.09.06 we Define RESULT/DEFAULT if FPC_DELPHI is defined 36 | 1.27 14.11.06 we HAS_ASSERT for FPC VER1 and VER2 37 | 1.28 28.11.06 we HAS_UNSAFE, $warn SYMBOL_../UNSAFE_.. OFF 38 | 1.29 25.05.07 we D11 aka Delphi 2007, FPC2.1.4 39 | 1.30 23.06.07 we FPC_ProcVar: Helper for procedure variables 40 | 1.31 18.09.07 we HAS_INLINE for FPC VER2 41 | 1.32 04.10.07 we FPC Intel ASMmode only if CPUI386 is defined 42 | 1.33 22.11.07 we Record value of $X option, undef RESULT if $X- 43 | 1.34 19.05.08 we HAS_UINT64 44 | 1.35 21.06.08 we V7PLUS, HAS_UINT64 for FPC VER2_2 45 | 1.36 07.09.08 we HAS_CARD32 46 | 1.37 21.11.08 we D12 aka D2009 47 | 1.38 19.02.09 we TPW 1.0 adjustments 48 | 1.39 05.07.09 we D12Plus 49 | 1.40 17.10.09 we BASM (BASM16 or Bit32) 50 | 1.41 21.10.09 we HAS_OVERLOAD 51 | 1.42 07.04.10 we HAS_DENORM_LIT (Denormalised extended literals, e.g. -1.23e-4942) 52 | 1.43 20.06.10 we D14 (VER210) 53 | 1.45 16.10.10 we WIN16 54 | 1.46 05.11.10 we FPC VER2_4 55 | 1.47 12.11.11 we FPC VER2_6 56 | 1.48 01.01.12 we HAS_UINT64 for FPC VER2_6 57 | 1.49 12.01.12 we BIT64, WIN32or64, Bit32or64 58 | 1.50 13.01.12 we EXT64 (64 bit extended = double) 59 | 1.51 19.01.12 we Define EXT64 if SIMULATE_EXT64 60 | 1.52 05.09.12 we Basic support for D14, D15(XE), D16(XE2), D17(XE3) 61 | 1.53 01.12.12 we Simplified FPC 2.X.Y definitions 62 | 1.54 17.12.12 we UNIT_SCOPE (D16/D17) 63 | 1.55 25.12.12 we J_OPT for BIT64 64 | 1.56 25.04.13 we D18/XE4 (VER250) 65 | 1.57 28.09.13 we Basic support for D19/XE5 (VER260) 66 | 1.58 17.04.14 we Basic support for D20/XE6 (VER270) 67 | 1.59 06.05.14 we FPC/CPUARM: $define EXT64, i.e. no FP 80-bit extended 68 | 1.60 13.09.14 we Basic support for D21/XE7 (VER280) 69 | 1.61 22.10.14 we HAS_OUT 70 | 1.62 13.01.15 we FPC VER3 (FPC3.0.1/3.1.1), FPC2Plus, FPC271or3 71 | 1.63 22.04.15 we Basic support for D22/XE8 (VER290) 72 | 1.64 25.04.15 we HAS_INTXX, HAS_PINTXX 73 | 1.65 01.09.15 we Basic support for D23 (VER300) 'Seattle' 74 | 1.66 26.04.16 we Basic support for D24 (VER310) 'Berlin' 75 | 1.67 17.03.17 we Define PurePascal for FPC/CPUARM 76 | 1.68 11.04.17 we Basic support for D25 (VER320) 'Tokyo' 77 | **************************************************************************) 78 | 79 | 80 | (*------------------------------------------------------------------------- 81 | (C) Copyright 2002-2017 Wolfgang Ehrhardt 82 | 83 | This software is provided 'as-is', without any express or implied warranty. 84 | In no event will the authors be held liable for any damages arising from 85 | the use of this software. 86 | 87 | Permission is granted to anyone to use this software for any purpose, 88 | including commercial applications, and to alter it and redistribute it 89 | freely, subject to the following restrictions: 90 | 91 | 1. The origin of this software must not be misrepresented; you must not 92 | claim that you wrote the original software. If you use this software in 93 | a product, an acknowledgment in the product documentation would be 94 | appreciated but is not required. 95 | 96 | 2. Altered source versions must be plainly marked as such, and must not be 97 | misrepresented as being the original software. 98 | 99 | 3. This notice may not be removed or altered from any source distribution. 100 | ----------------------------------------------------------------------------*) 101 | 102 | {$ifndef _STD_INC_} 103 | 104 | {$define _STD_INC_} {include STD.INC only once} 105 | 106 | {.$undef BIT16} {16 Bit code, Pascal / D1} 107 | {.$undef BIT32} {32 Bit code} 108 | {.$undef BIT64} {64 Bit code} 109 | {.$undef DELPHI} {Delphi2+ and BCB++} 110 | {.$undef G_OPT} {G+ option support} 111 | {.$undef D4PLUS} {Delphi 4 or higher} 112 | {.$undef BASM16} {16 Bit BASM} 113 | {.$undef LoadArgs} {Register params} 114 | {.$undef WINCRT} {Use WinCRT for console} 115 | {.$undef WIN16} {Compiler for 16-bit windows} 116 | {.$undef WIN32or64} {Compiler for 32/64-bit windows} 117 | {.$undef RESULT} {Result pseudo variable} 118 | {.$undef StrictLong} {Warning for longint const with MS bit} 119 | {.$undef HAS_INT64} { int64 integer type available} 120 | {.$undef HAS_UINT64} {uint64 integer type available} 121 | {.$undef HAS_CARD32} {Has 32 bit cardinal} 122 | {.$undef HAS_MSG} {Has message directive} 123 | {.$undef HAS_INLINE} {Has inline procs/funcs (D9)} 124 | {.$undef HAS_OUT} {Has OUT parameters: D3+, FPC2+ Delphi/ObjFPC} 125 | {.$undef ABSTRACT} {Has abstract methods} 126 | {.$undef DEFAULT} {Support default parameters} 127 | {.$undef VER5X} {TP5 or TP55} 128 | {.$undef HAS_XTYPES} {Xtra types in system: pByte, pLongint etc} 129 | {.$undef HAS_UNSAFE} {UNSAFE warnings} 130 | {.$undef APPCONS} {Needs "Apptype console" for console application} 131 | {.$undef FPC_ProcVar} {FPC handling of @ and proc variables} 132 | {.$undef FPC2Plus} {FPC 2 or newer} 133 | {.$undef FPC271or3} {FPC 271 or 3 (less accurate for 64 bit or SSE2)} 134 | {.$undef D12PLUS} {Delphi 12 or higher} 135 | {.$undef HAS_OVERLOAD} {Overloading of procedures and functions} 136 | {.$undef HAS_DENORM_LIT} {Denormalised (extended) literals, e.g. -1.23e-4942} 137 | {.$undef EXT64} {64 bit extended = double} 138 | {.$undef UNIT_SCOPE} {Unit scope name, D16+} 139 | {.$undef HAS_INTXX} {Int8 .. Int32, UInt8 .. UInt32} 140 | {.$undef HAS_PINTXX} {pInt8 .. pInt32, pUInt8 .. pUInt32} 141 | 142 | 143 | {$define CONST} {const in proc declaration} 144 | {$define Q_OPT} {Q- option support} 145 | {$define X_OPT} {X+ option support} 146 | {$define N_OPT} {N+ option support} 147 | {$define BASM} {BASM16 or BIT32} 148 | {$define V7PLUS} {TP7 or higher} 149 | 150 | 151 | {$ifdef VER10} {TPW 1.0} 152 | {$define BIT16} 153 | {$define BASM16} 154 | {$define WINCRT} 155 | {$define G_OPT} 156 | {$undef CONST} 157 | {$undef Q_OPT} 158 | {$undef V7PLUS} 159 | {$endif} 160 | 161 | {$ifdef VER15} {TPW 1.5} 162 | {$define BIT16} 163 | {$define BASM16} 164 | {$define WINCRT} 165 | {$define G_OPT} 166 | {$undef CONST} 167 | {$undef Q_OPT} 168 | {$undef V7PLUS} 169 | {$endif} 170 | 171 | {$ifdef VER50 } 172 | {$define BIT16} 173 | {$define VER5X} 174 | {$undef BASM} 175 | {$undef CONST} 176 | {$undef Q_OPT} 177 | {$undef X_OPT} 178 | {$undef V7PLUS} 179 | {$endif} 180 | 181 | {$ifdef VER55 } 182 | {$define BIT16} 183 | {$define VER5X} 184 | {$undef BASM} 185 | {$undef CONST} 186 | {$undef Q_OPT} 187 | {$undef X_OPT} 188 | {$undef V7PLUS} 189 | {$endif} 190 | 191 | {$ifdef VER60 } 192 | {$define BIT16} 193 | {$undef CONST} 194 | {$undef Q_OPT} 195 | {$define G_OPT} 196 | {$define BASM16} 197 | {$undef V7PLUS} 198 | {$endif} 199 | 200 | {$ifdef VER70 } 201 | {$define BIT16} 202 | {$define G_OPT} 203 | {$define BASM16} 204 | {$endif} 205 | 206 | {$ifdef VER80} 207 | {.$define DELPHI} {D1} {*we V1.05} 208 | {$define BIT16 } 209 | {$define G_OPT } 210 | {$define BASM16} 211 | {$define WINCRT} 212 | {$define RESULT} 213 | {$endif} 214 | 215 | {$ifdef VER90 } 216 | {$define DELPHI} {D2} 217 | {$endif} 218 | 219 | {$ifdef VER93 } 220 | {$define DELPHI} {BCB++1} 221 | {$endif} 222 | 223 | {$ifdef VER100} 224 | {$define DELPHI} {D3} 225 | {$define HAS_ASSERT} 226 | {$define HAS_OUT} 227 | {$endif} 228 | 229 | {$ifdef VER110} 230 | {$define DELPHI} {BCB3} 231 | {$define HAS_OUT} 232 | {$endif} 233 | 234 | {$ifdef VER120} 235 | {$define DELPHI} {D4} 236 | {$define D4PLUS} 237 | {$endif} 238 | 239 | {$ifdef VER125} 240 | {$define DELPHI} {BCB4} 241 | {$define D4PLUS} 242 | {$endif} 243 | 244 | {$ifdef VER130} 245 | {$define DELPHI} {D5} 246 | {$define D4PLUS} 247 | {$endif} 248 | 249 | {$ifdef VER140} 250 | {$define DELPHI} {D6} 251 | {$define D4PLUS} 252 | {$endif} 253 | 254 | {$ifdef VER150} 255 | {$define DELPHI} {D7} 256 | {$define D4PLUS} 257 | {$define HAS_UNSAFE} 258 | {$define HAS_UINT64} 259 | {$endif} 260 | 261 | {$ifdef VER170} 262 | {$define DELPHI} {D9} 263 | {$define D4PLUS} 264 | {$define HAS_INLINE} 265 | {$define HAS_UNSAFE} 266 | {$define HAS_UINT64} 267 | {$endif} 268 | 269 | {$ifdef VER180} 270 | {$define DELPHI} {D10, D11 ifdef VER185} 271 | {$define D4PLUS} 272 | {$define HAS_INLINE} 273 | {$define HAS_UNSAFE} 274 | {$define HAS_UINT64} 275 | {$endif} 276 | 277 | {$ifdef VER200} 278 | {$define DELPHI} {D12} 279 | {$define D12PLUS} 280 | {$endif} 281 | 282 | {$ifdef VER210} 283 | {$define DELPHI} {D14} 284 | {$define D12PLUS} 285 | {$endif} 286 | 287 | {$ifdef VER220} 288 | {$define DELPHI} {D15 - XE} 289 | {$define D12PLUS} 290 | {$endif} 291 | 292 | {$ifdef VER230} 293 | {$define DELPHI} {D16 - XE2} 294 | {$define D12PLUS} 295 | {$define UNIT_SCOPE} 296 | {$endif} 297 | 298 | {$ifdef VER240} 299 | {$define DELPHI} {D17 - XE3} 300 | {$define D12PLUS} 301 | {$define UNIT_SCOPE} 302 | {$endif} 303 | 304 | {$ifdef VER250} 305 | {$define DELPHI} {D18 - XE4} 306 | {$define D12PLUS} 307 | {$define UNIT_SCOPE} 308 | {$endif} 309 | 310 | {$ifdef VER260} 311 | {$define DELPHI} {D19 - XE5} 312 | {$define D12PLUS} 313 | {$define UNIT_SCOPE} 314 | {$endif} 315 | 316 | {$ifdef VER270} 317 | {$define DELPHI} {D20 - XE6} 318 | {$define D12PLUS} 319 | {$define UNIT_SCOPE} 320 | {$endif} 321 | 322 | {$ifdef VER280} 323 | {$define DELPHI} {D21 - XE7} 324 | {$define D12PLUS} 325 | {$define UNIT_SCOPE} 326 | {$endif} 327 | 328 | {$ifdef VER290} 329 | {$define DELPHI} {D22 - XE8} 330 | {$define D12PLUS} 331 | {$define UNIT_SCOPE} 332 | {$endif} 333 | 334 | {$ifdef VER300} 335 | {$define DELPHI} {D23} 336 | {$define D12PLUS} 337 | {$define UNIT_SCOPE} 338 | {$endif} 339 | 340 | {$ifdef VER310} 341 | {$define DELPHI} {D24} 342 | {$define D12PLUS} 343 | {$define UNIT_SCOPE} 344 | {$endif} 345 | 346 | {$ifdef VER320} 347 | {$define DELPHI} {D25} 348 | {$define D12PLUS} 349 | {$define UNIT_SCOPE} 350 | {$endif} 351 | 352 | 353 | {$ifdef CONDITIONALEXPRESSIONS} {D6+} 354 | {$ifndef D4PLUS} 355 | {$define D4PLUS} 356 | {$endif} 357 | {$define HAS_MSG} 358 | {$define HAS_XTYPES} 359 | {$ifdef CPUX64} 360 | {$define BIT64} 361 | {$endif} 362 | {$endif} 363 | 364 | {$ifdef VER70} 365 | {$ifdef windows} 366 | {$define WINCRT} 367 | {$endif} 368 | {$endif} 369 | 370 | {$ifdef VirtualPascal} 371 | {$define G_OPT} 372 | {$define RESULT} 373 | {$define LoadArgs} 374 | {$endif} 375 | 376 | {$ifdef WIN32} 377 | {$define J_OPT} 378 | {$endif} 379 | 380 | {$ifdef BIT64} 381 | {$define J_OPT} 382 | {$endif} 383 | 384 | {$ifdef FPC} 385 | {$define FPC_ProcVar} 386 | {$define ABSTRACT} 387 | {$define HAS_XTYPES} 388 | {$define HAS_OVERLOAD} 389 | {$undef N_OPT} 390 | {$ifdef VER1} 391 | {$undef J_OPT} 392 | {$define HAS_INT64} 393 | {$define HAS_CARD32} 394 | {$define HAS_MSG} 395 | {$define HAS_ASSERT} 396 | {$ifndef VER1_0} 397 | {FPC 1.9.x} 398 | {$define StrictLong} 399 | {$else} 400 | {$define LoadArgs} 401 | {$endif} 402 | {$endif} 403 | {$ifdef VER2} 404 | {$define FPC2Plus} 405 | {$define HAS_ASSERT} 406 | {$define HAS_INT64} 407 | {$define HAS_CARD32} 408 | {$define HAS_MSG} 409 | {$define HAS_INLINE} {Remember to use -Si} 410 | {$define StrictLong} 411 | {$ifdef FPC_OBJFPC} 412 | {$define DEFAULT} 413 | {$endif} 414 | {$ifdef FPC_DELPHI} 415 | {$define DEFAULT} 416 | {$endif} 417 | {$ifndef VER2_0} 418 | {$ifndef VER2_1} 419 | {$define HAS_UINT64} {2.2+} 420 | {$endif} 421 | {$define HAS_DENORM_LIT} {2.1+} 422 | {$endif} 423 | {$ifdef VER2_7_1} 424 | {$define FPC271or3} 425 | {$endif} 426 | {$ifdef VER2_6_2} 427 | {$define HAS_INTXX} 428 | {$endif} 429 | {$ifdef VER2_6_4} 430 | {$define HAS_INTXX} 431 | {$define HAS_PINTXX} 432 | {$endif} 433 | {$endif} 434 | {$ifdef VER3} 435 | {$define FPC2Plus} 436 | {$define FPC271or3} 437 | {$define HAS_ASSERT} 438 | {$define HAS_INT64} 439 | {$define HAS_CARD32} 440 | {$define HAS_MSG} 441 | {$define HAS_INLINE} 442 | {$define HAS_UINT64} 443 | {$define HAS_DENORM_LIT} 444 | {$define StrictLong} 445 | {$define HAS_INTXX} 446 | {$define HAS_PINTXX} 447 | {$ifdef FPC_OBJFPC} 448 | {$define DEFAULT} 449 | {$endif} 450 | {$ifdef FPC_DELPHI} 451 | {$define DEFAULT} 452 | {$endif} 453 | {$endif} 454 | 455 | {Note: Mode detection does not work for -Sxxx and version < 2.0.2} 456 | {$ifdef FPC_OBJFPC} 457 | {$define RESULT} 458 | {$define HAS_OUT} 459 | {$endif} 460 | {$ifdef FPC_DELPHI} 461 | {$define RESULT} 462 | {$define HAS_OUT} 463 | {$undef FPC_ProcVar} 464 | {$endif} 465 | {$ifdef FPC_TP} 466 | {$undef FPC_ProcVar} 467 | {$endif} 468 | {$ifdef FPC_GPC} 469 | {$undef FPC_ProcVar} 470 | {$endif} 471 | {$ifdef CPU64} 472 | {$define BIT64} 473 | {$endif} 474 | {$ifdef CPUARM} 475 | {$define EXT64} {No extended for ARM} 476 | {$define PurePascal} 477 | {$endif} 478 | {$endif} 479 | 480 | {$ifdef __TMT__} 481 | {$undef N_OPT} 482 | {$define RESULT} 483 | {$define HAS_INT64} 484 | {$define LoadArgs} 485 | {$ifdef __WIN32__} 486 | {$define WIN32} 487 | {$endif} 488 | {$endif} 489 | 490 | {$ifndef BIT16} 491 | {$define Bit32or64} 492 | {$ifndef BIT64} 493 | {$define BIT32} 494 | {$endif} 495 | {$endif} 496 | 497 | {$ifdef BIT16} 498 | {$ifdef WINDOWS} 499 | {$define WIN16} 500 | {$endif} 501 | {$endif} 502 | 503 | {$ifdef Delphi} 504 | {$define RESULT} 505 | {$define ABSTRACT} 506 | {$define HAS_DENORM_LIT} 507 | {$endif} 508 | 509 | {$ifdef D12Plus} 510 | {$ifndef D4PLUS} 511 | {$define D4PLUS} 512 | {$endif} 513 | {$define HAS_INLINE} 514 | {$define HAS_UNSAFE} 515 | {$define HAS_UINT64} 516 | {$define HAS_INTXX} 517 | {$endif} 518 | 519 | {$ifdef D4Plus} 520 | {$define HAS_OUT} 521 | {$define HAS_INT64} 522 | {$define HAS_CARD32} 523 | {$define StrictLong} 524 | {$define HAS_ASSERT} 525 | {$define DEFAULT} 526 | {$define HAS_OVERLOAD} 527 | {$endif} 528 | 529 | {$ifdef WIN32} 530 | {$define WIN32or64} 531 | {$ifndef VirtualPascal} 532 | {$define APPCONS} 533 | {$endif} 534 | {$endif} 535 | 536 | {$ifdef WIN64} 537 | {$define BIT64} 538 | {$define WIN32or64} 539 | {$define EXT64} 540 | {$define APPCONS} 541 | {$endif} 542 | 543 | {$ifdef BIT64} 544 | {$undef BASM} 545 | {$endif} 546 | 547 | 548 | {-- Default options --} 549 | 550 | {$ifndef FPC} 551 | {$B-} {short-circuit boolean expression evaluation, FPC has always B-!} 552 | {$endif} 553 | 554 | {$ifdef FPC} 555 | {$ifdef CPUI386} 556 | {$ASMmode intel} 557 | {$endif} 558 | {$goto on} 559 | {$endif} 560 | 561 | {$ifdef VirtualPascal} 562 | {$ifndef debug} 563 | {&Optimise+,SmartLink+,Speed+} 564 | {$endif} 565 | {$endif} 566 | 567 | {$ifdef G_OPT} 568 | {$G+} 569 | {$endif} 570 | 571 | {$ifdef Q_OPT} 572 | {Most Crypto and CRC/Hash units need Q-, define Q+ locally if needed} 573 | {$Q-} 574 | {$endif} 575 | 576 | {$ifdef debug} 577 | {$R+,S+} {Note: D9+ needs $R- for StrictLong setting!} 578 | {$else} 579 | {$R-,S-} 580 | {$endif} 581 | 582 | {$ifdef SIMULATE_EXT64} 583 | {$define EXT64} 584 | {$endif} 585 | 586 | {$ifdef BIT16} 587 | {$F-} 588 | {$endif} 589 | 590 | {-- Record the starting values of important local options --} 591 | {$ifopt A+} {$define Align_on} {$endif} 592 | {$ifopt B+} {$define BoolEval_on} {$endif} 593 | {$ifopt D+} {$define DebugInfo_on} {$endif} 594 | {$ifopt I+} {$define IOChecks_on} {$endif} 595 | {$ifopt R+} {$define RangeChecks_on} {$endif} 596 | {$ifopt V+} {$define VarStringChecks_on} {$endif} 597 | 598 | 599 | {$ifdef Q_OPT} 600 | {$ifopt P+} {$define OpenStrings_on} {$endif} 601 | {$ifopt Q+} {$define OverflowChecks_on} {$endif} 602 | {$endif} 603 | 604 | {-- Note that X option is GLOBAL --} 605 | {$ifdef X_OPT} 606 | {$ifopt X+} {$define ExtendedSyntax_on} {$endif} 607 | {$ifopt X-} {$undef RESULT} {$endif} 608 | {$endif} 609 | 610 | {$ifdef CONDITIONALEXPRESSIONS} 611 | {$warn SYMBOL_PLATFORM OFF} 612 | {$warn SYMBOL_DEPRECATED OFF} 613 | {$warn SYMBOL_LIBRARY OFF} 614 | {$warn UNIT_DEPRECATED OFF} 615 | {$warn UNIT_LIBRARY OFF} 616 | {$warn UNIT_PLATFORM OFF} 617 | {$ifdef HAS_UNSAFE} 618 | {$warn UNSAFE_TYPE OFF} 619 | {$warn UNSAFE_CODE OFF} 620 | {$warn UNSAFE_CAST OFF} 621 | {$endif} 622 | {$endif} 623 | 624 | {$else} 625 | 626 | {$ifdef HAS_MSG} 627 | {$message 'std.inc included more than once'} 628 | {$endif} 629 | 630 | {$endif} 631 | 632 | --------------------------------------------------------------------------------