├── .gitignore ├── BuiltTime.exe ├── HFS.Macroses.pas ├── HFS302_rus.utflng ├── README.md ├── RnQBuiltTime.inc ├── clear.bat ├── compressHFS.bat ├── defs.inc ├── filepropDlg.dfm ├── filepropDlg.pas ├── hfs.dpr ├── hfs.res ├── hfs.tray.pas ├── hfsGlobal.pas ├── hfsVars.pas ├── ipsEverDlg.dfm ├── ipsEverDlg.pas ├── jcl └── hfsJclOthers.pas ├── langLib.pas ├── lib ├── RegExpr.pas ├── diffDlg.dfm ├── diffDlg.pas ├── folderKindDlg.dfm ├── folderKindDlg.pas ├── longinputDlg.dfm ├── longinputDlg.pas ├── monoLib.pas ├── progFrmLib.pas ├── purgeDlg.dfm ├── purgeDlg.pas ├── shellExtDlg.dfm └── shellExtDlg.pas ├── listSelectDlg.dfm ├── listSelectDlg.pas ├── main.dfm ├── main.pas ├── newuserpassDlg.dfm ├── newuserpassDlg.pas ├── notes ├── deprecated.txt ├── developer notes.txt ├── notes.txt ├── todo.txt └── whatsnew.txt ├── optionsDlg.dfm ├── optionsDlg.pas ├── recompile data.bat ├── res ├── NoMacros.tpl ├── RapidD.public ├── WindowsXP.manifest ├── alias.txt ├── copyright.txt ├── data.rc ├── default.tpl ├── dmBrowser.tpl ├── dmBrowser.tpl.gz ├── filelist.tpl ├── fontello.json ├── hfs_Icon.ico ├── ipservices.txt ├── jquery.min.js.gz ├── numbers.png ├── numbers32.png └── shell.png ├── runscriptDlg.dfm ├── runscriptDlg.pas ├── srv ├── IconsLib.dfm ├── IconsLib.pas ├── fileLib.pas ├── hsUtils.pas ├── hslib.pas ├── netUtils.pas ├── parserLib.pas ├── scriptLib.pas ├── serverLib.pas ├── srvClassesLib.pas ├── srvConst.pas ├── srvUtils.pas └── srvVars.pas └── utillib.pas /.gitignore: -------------------------------------------------------------------------------- 1 | tmp/ 2 | __history/ 3 | __recovery/ 4 | win32/ 5 | .vscode/ 6 | *.vfs 7 | *.dcu 8 | *.exe 9 | *.map 10 | *.tmp 11 | *.dll 12 | *.bak 13 | *.*- 14 | *.corrupted 15 | hfs.ini 16 | hfs.identcache 17 | hfs.tpl 18 | hfs_project.tvsconfig 19 | data.res 20 | macros-log.html 21 | RnQBuiltTime.inc 22 | ################# 23 | ## Delphi 24 | ################# 25 | *.dcu 26 | *.local 27 | *.identcache 28 | *.stat 29 | *.dproj.local 30 | *.bak 31 | *.ddp 32 | *.~* 33 | *.drc 34 | *.rsm 35 | -------------------------------------------------------------------------------- /BuiltTime.exe: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/drapid/HFS/06a40abe58c47b63bbe60fd63767d33c123d8d44/BuiltTime.exe -------------------------------------------------------------------------------- /HFS302_rus.utflng: -------------------------------------------------------------------------------- 1 | ######## Перевод на Русский 2 | [] 3 | desc=Русский 4 | [Open in browser] 5 | Открыть в браузере 6 | [Top speed] 7 | Макс. скорость 8 | [Menu] 9 | Меню 10 | [Self Test] 11 | Самодиагностика 12 | [De&bug] 13 | Отладка 14 | [Debug] 15 | Отладка 16 | [Donate!] 17 | Пожертвовать 18 | [Other options] 19 | Другие настройки 20 | [Help] 21 | Помощь 22 | [Add files...] 23 | Добавить файлы... 24 | [Save options] 25 | Сохранить настройки 26 | [Add folder from disk...] 27 | Добавить папку с диска... 28 | 29 | [You are in Expert mode] 30 | Вы в режиме Эксперт 31 | [Copy to clipboard] 32 | Копировать в буфер обмена 33 | [Virtual File System] 34 | Виртуальная Файловая Система 35 | [File] 36 | Файл 37 | [Progress] 38 | Ход 39 | [IP address] 40 | IP Адрес 41 | [Status] 42 | Статус 43 | [Speed] 44 | Скорость 45 | [Time left] 46 | Оставшееся время 47 | 48 | resourcestrings: 49 | [Port: %s] 50 | Порт: %s 51 | [any] 52 | любой 53 | [The current template is using macros.\rDo you want to cancel this action?] 54 | Текущий шаблон использует макрос.\rВы хотите отменить это действие? 55 | [Remove from shell context menu] 56 | Удалится из контекстного меню оболочки 57 | [Uninstall HFS] 58 | Деинсталировать HFS 59 | [Switch OFF] 60 | ВЫКЛЮЧИТЬ 61 | [Switch ON] 62 | ВКЛЮЧИТЬ 63 | [Exit] 64 | Выйти 65 | [Log] 66 | Журнал 67 | [Connections: %d] 68 | Соединений: %d 69 | [Total In: %s] 70 | Всего пришло: %s 71 | [Total Out: %s] 72 | Всего ушло: %s 73 | [Out: %.1f KB/s] 74 | Исход: %.1f КБ/с 75 | [In: %.1f KB/s] 76 | Вход: %.1f КБ/с 77 | [Ban rules: %d] 78 | Заблокировано: %d 79 | [Mem] 80 | Памяти 81 | [Customized template] 82 | Изменёный шаблон 83 | [VFS: %d items] 84 | ВФС: %d позиций 85 | [VFS: %d items - not saved] 86 | ВФС: %d позиций - не сохранено 87 | [You are invited to re-insert your No-IP configuration, otherwise the updater won't work as expected.] 88 | You are invited to re-insert your No-IP configuration, otherwise the updater won't work as expected. 89 | L"Max simultaneous addresses." 90 | L"In this moment there are %d different addresses" 91 | L"Max simultaneous addresses downloading." 92 | L"In this moment there are %d different addresses downloading" 93 | L"Max lines on screen" 94 | L"Here you can specify how to format the log file complying Apache standard.\rLeave blank to get bare copy of screen on file.\r\rExample:\r %h %l %u %t \"%r\" %>s %b" 95 | L"This option creates an .md5 file for every new calculated fingerprint.\rUse with care to get not your disk invaded by these files." 96 | L"When you add files and no fingerprint is found, it is calculated.\rTo avoid long waitings, set a limit to file size (in KiloBytes).\rLeave empty to disable, and have no fingerprint created." 97 | L"This feature is INCOMPATIBLE with Internet Explorer." 98 | L"Specify your addresses, each per line" 99 | L"Can't find external address\r( %s )" 100 | 101 | 102 | 103 | [Images] 104 | Изображения 105 | [Draft] 106 | Эскиз 107 | 108 | [Credits >] 109 | Благодарности 110 | [< About] 111 | О программе 112 | [About...] 113 | О программе... 114 | 115 | 116 | [Width] 117 | Ширина 118 | [Height] 119 | Высота 120 | 121 | [SET] 122 | Установить 123 | 124 | [days] 125 | дней 126 | 127 | [Use the forum for support or to contact us] 128 | Используйте форум, чтобы связаться с нами 129 | 130 | [none] 131 | Нет 132 | [lock] 133 | заблокировать 134 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | ## Introduction 2 | You can use HFS (HTTP File Server) to send and receive files. 3 | It's different from classic file sharing because it uses web technology. 4 | It also differs from classic web servers because it's very easy to use and runs "right out-of-the box". 5 | 6 | The virtual file system will allow you to easily share even one single file. 7 | 8 | 9 | http://rejetto.com/hfs/ 10 | 11 | ## Dev notes 12 | Initially developed in 2002 with Delphi 6, now with Delphi 10.3.3 (Community Edition). 13 | Icons are generated at http://fontello.com/ . Use fontello.json for further modifications. 14 | 15 | For the default template we are targeting compatibility with Chrome 49 as it's the latest version running on Windows XP. 16 | 17 | ## Modification: 18 | - Uses for.rnq from R&Q 19 | - All images are PNG with alpha-channel 20 | - New format for VFS saving (ZIP file with JSON and images as separate files) 21 | 22 | Now it can be build with full unicode support and in X64. 23 | Unicode 24 | 25 | ## Libs used 26 | - [ICS v9](http://www.overbyte.be) by François PIETTE 27 | - [For.RnQ](https://github.com/drapid/rnq/tree/master/for.RnQ) 28 | - [Synopse mORMot2](https://github.com/synopse/mORMot2) 29 | -------------------------------------------------------------------------------- /RnQBuiltTime.inc: -------------------------------------------------------------------------------- 1 | { 18.02.2025 18:10:05 } 2 | BuiltTime = 45706.7570089236; -------------------------------------------------------------------------------- /clear.bat: -------------------------------------------------------------------------------- 1 | @IF EXIST "*.~*" del *.~* 2 | @IF EXIST "*.dcu" del *.dcu 3 | @IF EXIST "*.ddp" del *.ddp 4 | @IF EXIST "*.ppu" del *.ppu 5 | @IF EXIST "*.o" del *.o 6 | @IF EXIST "*.bak" del *.bak 7 | @IF EXIST "*.identcache " del *.identcache 8 | @IF EXIST ".\Units\*.dcu" del .\Units\*.dcu 9 | @IF EXIST ".\UnitsWin32\*.dcu" del .\UnitsWin32\*.dcu 10 | @IF EXIST ".\UnitsWin64\*.dcu" del .\UnitsWin64\*.dcu 11 | @IF EXIST "Prefs\__history\*" del /q Prefs\__history\* 12 | @IF EXIST "Prefs\*.bak" del /q Prefs\*.bak 13 | @IF EXIST "Prefs\*.dcu" del /q Prefs\*.dcu 14 | @IF EXIST "__history\*" del /q __history\* 15 | @IF EXIST "srv\__history\*" del /q srv\__history\* 16 | @IF EXIST "srv\*.bak" del /q srv\*.bak 17 | @IF EXIST "lib\__history\*" del /q lib\__history\* 18 | @IF EXIST "lib\*.bak" del /q lib\*.bak 19 | 20 | @rem exit -------------------------------------------------------------------------------- /compressHFS.bat: -------------------------------------------------------------------------------- 1 | @set BB=325 2 | @IF "%1" EQU "x64" goto x64 3 | @ECHO Processing x86 4 | @copy binWin32\hfs.exe "binWin32\HFS%BB%_RD.exe" 5 | @upx.exe -9 --lzma "binWin32\HFS%BB%_RD.exe" 6 | exit 7 | :x64 8 | @ECHO Processing x64 9 | @copy binWin64\hfs.exe "binWin64\HFS%BB%_RDx64.exe" 10 | @upx.exe -9 --lzma "binWin64\HFS%BB%_RDx64.exe" 11 | -------------------------------------------------------------------------------- /defs.inc: -------------------------------------------------------------------------------- 1 | {$DEFINE STABLE } 2 | {$IFDEF STABLE } 3 | {$ASSERTIONS OFF} 4 | {$ELSE} 5 | {$ASSERTIONS ON} 6 | {!$DEFINE EX_DEBUG} 7 | {$ENDIF} 8 | {$WARN SYMBOL_PLATFORM off } 9 | {$WARN UNIT_PLATFORM off } 10 | {$I-} 11 | {$INLINE AUTO} 12 | 13 | { $DEFINE HAS_FASTMM} 14 | { $DEFINE ZIP_ZSTD} 15 | {$DEFINE USE_MORMOT_COLLECTIONS} 16 | {$DEFINE DELPHI9_UP} 17 | {$IFNDEF FPC} 18 | {$DEFINE USE_SSL} 19 | {$DEFINE USE_IPv6} 20 | {$ENDIF ~FPC} 21 | 22 | -------------------------------------------------------------------------------- /filepropDlg.dfm: -------------------------------------------------------------------------------- 1 | object filepropFrm: TfilepropFrm 2 | Left = 0 3 | Top = 0 4 | Caption = 'filepropFrm' 5 | ClientHeight = 401 6 | ClientWidth = 393 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -11 11 | Font.Name = 'Tahoma' 12 | Font.Style = [] 13 | KeyPreview = True 14 | Position = poMainFormCenter 15 | ShowHint = True 16 | OnClose = FormClose 17 | OnKeyPress = FormKeyPress 18 | OnShow = FormShow 19 | TextHeight = 13 20 | object pages: TPageControl 21 | Left = 0 22 | Top = 0 23 | Width = 393 24 | Height = 366 25 | ActivePage = permTab 26 | Align = alClient 27 | ParentShowHint = False 28 | RaggedRight = True 29 | ShowHint = True 30 | TabOrder = 0 31 | object permTab: TTabSheet 32 | Caption = 'Permissions' 33 | ImageIndex = 1 34 | object actionTabs: TTabControl 35 | Left = 0 36 | Top = 0 37 | Width = 385 38 | Height = 338 39 | Align = alClient 40 | MultiLine = True 41 | TabOrder = 0 42 | OnChange = actionTabsChange 43 | DesignSize = ( 44 | 385 45 | 338) 46 | object newaccBtn: TButton 47 | Left = 278 48 | Top = 56 49 | Width = 92 50 | Height = 25 51 | Anchors = [akTop, akRight] 52 | Caption = 'New account' 53 | TabOrder = 0 54 | OnClick = newaccBtnClick 55 | end 56 | object anyAccChk: TCheckBox 57 | Left = 278 58 | Top = 151 59 | Width = 97 60 | Height = 17 61 | Anchors = [akTop, akRight] 62 | Caption = 'Any account' 63 | TabOrder = 1 64 | OnClick = anonChkClick 65 | end 66 | object anonChk: TCheckBox 67 | Left = 278 68 | Top = 183 69 | Width = 97 70 | Height = 17 71 | Anchors = [akTop, akRight] 72 | Caption = 'Anonymous' 73 | TabOrder = 2 74 | OnClick = anonChkClick 75 | end 76 | object allBtn: TButton 77 | Left = 278 78 | Top = 95 79 | Width = 92 80 | Height = 25 81 | Anchors = [akTop, akRight] 82 | Caption = 'All / None' 83 | TabOrder = 3 84 | OnClick = allBtnClick 85 | end 86 | object accountsBox: TListView 87 | Left = 16 88 | Top = 40 89 | Width = 247 90 | Height = 285 91 | Anchors = [akLeft, akTop, akRight, akBottom] 92 | Checkboxes = True 93 | Columns = <> 94 | TabOrder = 4 95 | ViewStyle = vsList 96 | OnChange = accountsBoxChange 97 | OnGetImageIndex = accountsBoxGetImageIndex 98 | end 99 | object anyoneChk: TCheckBox 100 | Left = 278 101 | Top = 216 102 | Width = 97 103 | Height = 17 104 | Anchors = [akTop, akRight] 105 | Caption = 'Anyone' 106 | TabOrder = 5 107 | OnClick = anonChkClick 108 | end 109 | object goToAccountsBtn: TButton 110 | Left = 278 111 | Top = 288 112 | Width = 92 113 | Height = 33 114 | Anchors = [akTop, akRight] 115 | Caption = 'Manage accounts' 116 | TabOrder = 6 117 | WordWrap = True 118 | OnClick = goToAccountsBtnClick 119 | end 120 | end 121 | end 122 | object flagsTab: TTabSheet 123 | Caption = 'Flags' 124 | ImageIndex = 2 125 | object hiddenChk: TCheckBox 126 | Left = 32 127 | Top = 24 128 | Width = 180 129 | Height = 17 130 | Hint = 'Test' 131 | Caption = 'Hidden' 132 | Enabled = False 133 | TabOrder = 0 134 | end 135 | object hidetreeChk: TCheckBox 136 | Left = 32 137 | Top = 56 138 | Width = 180 139 | Height = 17 140 | Caption = 'Recursively hidden' 141 | Enabled = False 142 | TabOrder = 1 143 | end 144 | object archivableChk: TCheckBox 145 | Left = 32 146 | Top = 121 147 | Width = 273 148 | Height = 17 149 | Caption = 'Archivable' 150 | Enabled = False 151 | TabOrder = 2 152 | end 153 | object browsableChk: TCheckBox 154 | Left = 32 155 | Top = 88 156 | Width = 97 157 | Height = 17 158 | Caption = 'Browsable' 159 | Enabled = False 160 | TabOrder = 3 161 | end 162 | object dontlogChk: TCheckBox 163 | Left = 32 164 | Top = 184 165 | Width = 97 166 | Height = 17 167 | Caption = 'Don'#39't log' 168 | Enabled = False 169 | TabOrder = 4 170 | end 171 | object nodlChk: TCheckBox 172 | Left = 32 173 | Top = 152 174 | Width = 97 175 | Height = 17 176 | Caption = 'No download' 177 | Enabled = False 178 | TabOrder = 5 179 | end 180 | object dontconsiderChk: TCheckBox 181 | Left = 32 182 | Top = 216 183 | Width = 273 184 | Height = 17 185 | Caption = 'Don'#39't consider as download' 186 | Enabled = False 187 | TabOrder = 6 188 | end 189 | object hideemptyChk: TCheckBox 190 | Left = 32 191 | Top = 249 192 | Width = 313 193 | Height = 17 194 | Caption = 'Auto-hide empty folders' 195 | Enabled = False 196 | TabOrder = 7 197 | end 198 | object hideextChk: TCheckBox 199 | Left = 32 200 | Top = 280 201 | Width = 201 202 | Height = 17 203 | Caption = 'Hide file extension in listing' 204 | Enabled = False 205 | TabOrder = 8 206 | end 207 | end 208 | object diffTab: TTabSheet 209 | Caption = 'Diff template' 210 | ImageIndex = 3 211 | object difftplBox: TMemo 212 | Left = 0 213 | Top = 0 214 | Width = 385 215 | Height = 338 216 | Hint = 217 | 'Here you can put a partial template that will overlap the main o' + 218 | 'ne.' 219 | Align = alClient 220 | ScrollBars = ssVertical 221 | TabOrder = 0 222 | OnEnter = textinputEnter 223 | end 224 | end 225 | object commentTab: TTabSheet 226 | Caption = 'Comment' 227 | ImageIndex = 4 228 | object commentBox: TMemo 229 | Left = 0 230 | Top = 0 231 | Width = 385 232 | Height = 338 233 | Align = alClient 234 | ScrollBars = ssVertical 235 | TabOrder = 0 236 | OnEnter = textinputEnter 237 | end 238 | end 239 | object maskTab: TTabSheet 240 | Caption = 'File masks' 241 | ImageIndex = 5 242 | DesignSize = ( 243 | 385 244 | 338) 245 | object filesfilterBox: TLabeledEdit 246 | Left = 10 247 | Top = 32 248 | Width = 357 249 | Height = 21 250 | Anchors = [akLeft, akTop, akRight] 251 | EditLabel.Width = 46 252 | EditLabel.Height = 13 253 | EditLabel.Caption = 'Files filter' 254 | Enabled = False 255 | TabOrder = 0 256 | Text = '' 257 | OnEnter = textinputEnter 258 | ExplicitWidth = 365 259 | end 260 | object foldersfilterBox: TLabeledEdit 261 | Left = 10 262 | Top = 78 263 | Width = 357 264 | Height = 21 265 | Anchors = [akLeft, akTop, akRight] 266 | EditLabel.Width = 60 267 | EditLabel.Height = 13 268 | EditLabel.Caption = 'Folders filter' 269 | Enabled = False 270 | TabOrder = 1 271 | Text = '' 272 | OnEnter = textinputEnter 273 | ExplicitWidth = 365 274 | end 275 | object deffileBox: TLabeledEdit 276 | Left = 10 277 | Top = 125 278 | Width = 357 279 | Height = 21 280 | Hint = 281 | 'When a folder is browsed, the default file mask is used to find ' + 282 | 'a file to serve in place of the folder page. If no file is found' + 283 | ', the folder page is served.' 284 | Anchors = [akLeft, akTop, akRight] 285 | EditLabel.Width = 79 286 | EditLabel.Height = 13 287 | EditLabel.Caption = 'Default file mask' 288 | Enabled = False 289 | TabOrder = 2 290 | Text = '' 291 | OnEnter = textinputEnter 292 | ExplicitWidth = 365 293 | end 294 | object uploadfilterBox: TLabeledEdit 295 | Left = 10 296 | Top = 171 297 | Width = 357 298 | Height = 21 299 | Hint = 'Uploaded files are allowed only complying with this file mask' 300 | Anchors = [akLeft, akTop, akRight] 301 | EditLabel.Width = 85 302 | EditLabel.Height = 13 303 | EditLabel.Caption = 'Upload filter mask' 304 | Enabled = False 305 | TabOrder = 3 306 | Text = '' 307 | OnEnter = textinputEnter 308 | ExplicitWidth = 365 309 | end 310 | object dontconsiderBox: TLabeledEdit 311 | Left = 10 312 | Top = 218 313 | Width = 357 314 | Height = 21 315 | Hint = 316 | 'Files matching this filemask are not considered for global downl' + 317 | 'oads counter. Moreover they never get tray icon.' 318 | Anchors = [akLeft, akTop, akRight] 319 | EditLabel.Width = 166 320 | EditLabel.Height = 13 321 | EditLabel.Caption = 'Don'#39't consider as download (mask)' 322 | Enabled = False 323 | TabOrder = 4 324 | Text = '' 325 | OnEnter = textinputEnter 326 | ExplicitWidth = 365 327 | end 328 | end 329 | object otherTab: TTabSheet 330 | Caption = 'Other' 331 | ImageIndex = 5 332 | DesignSize = ( 333 | 385 334 | 338) 335 | object Label1: TLabel 336 | Left = 10 337 | Top = 72 338 | Width = 21 339 | Height = 13 340 | Caption = 'Icon' 341 | FocusControl = iconBox 342 | end 343 | object realmBox: TLabeledEdit 344 | Left = 10 345 | Top = 32 346 | Width = 357 347 | Height = 21 348 | Hint = 349 | 'The realm string is shown on the user/pass dialog of the browser' + 350 | '. This realm will be used for selected files and their descendan' + 351 | 'ts.' 352 | Anchors = [akLeft, akTop, akRight] 353 | EditLabel.Width = 29 354 | EditLabel.Height = 13 355 | EditLabel.Caption = 'Realm' 356 | Enabled = False 357 | TabOrder = 0 358 | Text = '' 359 | OnEnter = textinputEnter 360 | ExplicitWidth = 365 361 | end 362 | object iconBox: TComboBoxEx 363 | Left = 10 364 | Top = 91 365 | Width = 127 366 | Height = 22 367 | ItemsEx = <> 368 | Style = csExDropDownList 369 | TabOrder = 1 370 | end 371 | object addiconBtn: TButton 372 | Left = 152 373 | Top = 91 374 | Width = 75 375 | Height = 22 376 | Caption = 'Add new...' 377 | TabOrder = 2 378 | OnClick = addiconBtnClick 379 | end 380 | end 381 | end 382 | object Panel1: TPanel 383 | Left = 0 384 | Top = 366 385 | Width = 393 386 | Height = 35 387 | Align = alBottom 388 | BevelOuter = bvNone 389 | TabOrder = 1 390 | DesignSize = ( 391 | 393 392 | 35) 393 | object okBtn: TButton 394 | Left = 144 395 | Top = 6 396 | Width = 75 397 | Height = 25 398 | Anchors = [akTop, akRight] 399 | Caption = '&OK' 400 | Default = True 401 | ModalResult = 1 402 | TabOrder = 0 403 | ExplicitLeft = 152 404 | end 405 | object cancelBtn: TButton 406 | Left = 305 407 | Top = 6 408 | Width = 75 409 | Height = 25 410 | Anchors = [akTop, akRight] 411 | Caption = 'Cancel' 412 | ModalResult = 2 413 | TabOrder = 1 414 | ExplicitLeft = 313 415 | end 416 | object applyBtn: TButton 417 | Left = 224 418 | Top = 6 419 | Width = 75 420 | Height = 25 421 | Anchors = [akTop, akRight] 422 | Caption = '&Apply' 423 | TabOrder = 2 424 | OnClick = applyBtnClick 425 | ExplicitLeft = 232 426 | end 427 | end 428 | end 429 | -------------------------------------------------------------------------------- /filepropDlg.pas: -------------------------------------------------------------------------------- 1 | unit filepropDlg; 2 | 3 | interface 4 | 5 | uses 6 | Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 7 | Dialogs, ComCtrls, StdCtrls, ExtCtrls, CheckLst, types, Grids, Vcl.Mask, 8 | ValEdit, strutils, math, 9 | hslib, serverLib, srvClassesLib, fileLib, hfsGlobal; 10 | 11 | type 12 | 13 | { TfilepropFrm } 14 | 15 | TfilepropFrm = class(TForm) 16 | pages: TPageControl; 17 | permTab: TTabSheet; 18 | flagsTab: TTabSheet; 19 | diffTab: TTabSheet; 20 | commentTab: TTabSheet; 21 | maskTab: TTabSheet; 22 | hiddenChk: TCheckBox; 23 | hidetreeChk: TCheckBox; 24 | archivableChk: TCheckBox; 25 | browsableChk: TCheckBox; 26 | dontlogChk: TCheckBox; 27 | nodlChk: TCheckBox; 28 | dontconsiderChk: TCheckBox; 29 | hideemptyChk: TCheckBox; 30 | hideextChk: TCheckBox; 31 | Panel1: TPanel; 32 | okBtn: TButton; 33 | cancelBtn: TButton; 34 | difftplBox: TMemo; 35 | commentBox: TMemo; 36 | actionTabs: TTabControl; 37 | newaccBtn: TButton; 38 | anyAccChk: TCheckBox; 39 | anonChk: TCheckBox; 40 | allBtn: TButton; 41 | accountsBox: TListView; 42 | filesfilterBox: TLabeledEdit; 43 | foldersfilterBox: TLabeledEdit; 44 | deffileBox: TLabeledEdit; 45 | uploadfilterBox: TLabeledEdit; 46 | dontconsiderBox: TLabeledEdit; 47 | otherTab: TTabSheet; 48 | realmBox: TLabeledEdit; 49 | anyoneChk: TCheckBox; 50 | iconBox: TComboBoxEx; 51 | Label1: TLabel; 52 | addiconBtn: TButton; 53 | goToAccountsBtn: TButton; 54 | applyBtn: TButton; 55 | procedure accountsBoxGetImageIndex(Sender: TObject; Item: TListItem); 56 | procedure actionTabsChange(Sender: TObject); 57 | procedure newaccBtnClick(Sender: TObject); 58 | procedure allBtnClick(Sender: TObject); 59 | procedure accountsBoxChange(Sender: TObject; Item: TListItem; Change: TItemChange); 60 | procedure anonChkClick(Sender: TObject); 61 | procedure FormShow(Sender: TObject); 62 | procedure textinputEnter(Sender: TObject); 63 | procedure FormClose(Sender: TObject; var Action: TCloseAction); 64 | procedure FormKeyPress(Sender: TObject; var Key: Char); 65 | procedure addiconBtnClick(Sender: TObject); 66 | procedure goToAccountsBtnClick(Sender: TObject); 67 | procedure applyBtnClick(Sender: TObject); 68 | private 69 | iconOfs: integer; 70 | procedure DoShow(fileTree: TTreeView; selectedFile: Tfile; fileSrv: TFileServer); 71 | public 72 | firstActionChange: boolean; 73 | users: array [TfileAction] of TStringDynArray; 74 | savePerm: array [TfileAction] of boolean; // should we apply/save permissions for this TfileAction ? 75 | currAction, prevAction: TfileAction; 76 | procedure updateAccountsBox; 77 | end; 78 | 79 | var 80 | filepropFrm: TfilepropFrm; 81 | 82 | implementation 83 | 84 | uses 85 | optionsDlg, RDUtils, 86 | main, 87 | utilLib, 88 | srvConst, srvUtils, srvVars, 89 | IconsLib; 90 | 91 | {$R *.dfm} 92 | 93 | procedure TfilepropFrm.accountsBoxChange(Sender: TObject; Item: TListItem; Change: TItemChange); 94 | begin 95 | if (change = ctState) 96 | and (item.caption > '') 97 | and (stringExists(item.caption, users[currAction]) <> item.checked) then 98 | begin 99 | savePerm[currAction]:=TRUE; 100 | toggleString(item.caption, users[currAction]) 101 | end; 102 | end; 103 | 104 | procedure TfilepropFrm.accountsBoxGetImageIndex(Sender: TObject; Item: TListItem); 105 | begin item.ImageIndex:=accountIcon(item.data) end; 106 | 107 | function str2fileaction(const s: String): TfileAction; 108 | begin 109 | for result:=low(result) to high(result) do 110 | if FILEACTION2STR[result] = s then 111 | exit; 112 | result := TfileAction(-1); 113 | end; // str2fileaction 114 | 115 | procedure TfilepropFrm.actionTabsChange(Sender: TObject); 116 | var 117 | l: TstringList; 118 | i: integer; 119 | ar: TstringDynArray; 120 | begin 121 | currAction:=str2fileaction(actionTabs.tabs[actionTabs.tabIndex]); 122 | if not firstActionChange then 123 | begin 124 | // we must save current selection before updating the checkmarks 125 | ar:=users[prevAction]; 126 | // now 'ar' is actually an alias, no duplication 127 | setLength(ar, 0); 128 | if anonChk.checked then 129 | addString(USER_ANONYMOUS, ar); 130 | if anyAccChk.checked then 131 | addString(USER_ANY_ACCOUNT, ar); 132 | if anyoneChk.checked then 133 | addString(USER_ANYONE, ar); 134 | for i:=0 to accountsBox.Items.Count-1 do 135 | with accountsBox.Items[i] do 136 | if checked then 137 | addString(caption, ar); 138 | 139 | prevAction := currAction; 140 | end; 141 | firstActionChange:=FALSE; 142 | 143 | l := arrayToList(users[currAction]); 144 | try 145 | for i:=0 to accountsBox.Items.Count-1 do 146 | with accountsBox.Items[i] do 147 | checked := l.IndexOf(caption) >= 0; 148 | anonChk.checked := l.IndexOf(USER_ANONYMOUS) >= 0; 149 | anyAccChk.checked := l.indexOf(USER_ANY_ACCOUNT) >= 0; 150 | anyoneChk.checked := l.indexOf(USER_ANYONE) >= 0; 151 | finally 152 | l.free 153 | end; 154 | end; 155 | 156 | procedure TfilepropFrm.addiconBtnClick(Sender: TObject); 157 | var 158 | fn: string; 159 | i: integer; 160 | begin 161 | if not promptForFileName(fn) then 162 | exit; 163 | i := IconsDM.getImageIndexForFile(fn); 164 | if i < 0 then 165 | exit; 166 | iconBox.itemsEx.addItem(idx_label(i), i, i, -1, 0, NIL); 167 | iconBox.itemIndex := iconOfs+i; 168 | end; 169 | 170 | procedure TfilepropFrm.FormClose(Sender: TObject; var Action: TCloseAction); 171 | begin 172 | if (action = caHide) and (modalResult = mrOk) then 173 | applyBtnClick(applyBtn); 174 | end; 175 | 176 | procedure TfilepropFrm.FormKeyPress(Sender: TObject; var Key: Char); 177 | begin 178 | if pages.focused then 179 | if (key>='1') and (key<='9') then 180 | try pages.TabIndex:=ord(key)-ord('0')-1 181 | except end; 182 | end; 183 | 184 | procedure TfilepropFrm.DoShow(fileTree: TTreeView; selectedFile: Tfile; fileSrv: TFileServer); 185 | var 186 | i: integer; 187 | f: Tfile; 188 | 189 | procedure setFlag(flag: TfileAttribute; cb: TCheckBox); 190 | var 191 | should: TCheckBoxState; 192 | begin 193 | cb.enabled:=TRUE; 194 | if flag in f.flags then 195 | should:=cbChecked 196 | else 197 | should:=cbUnchecked; 198 | if i = 0 then 199 | cb.state:=should 200 | else 201 | if (cb.state <> cbGrayed) and (cb.state <> should) then 202 | cb.state:=cbGrayed; 203 | end; // setFlag 204 | 205 | procedure setText(var v: string; box: TCustomEdit); 206 | const 207 | COLOR = clInfoBk; 208 | var 209 | n: integer; 210 | begin 211 | n := countSubstr(#0, box.hint); 212 | box.enabled:=TRUE; 213 | if n = 0 then 214 | begin // init this edit box 215 | box.text:=v; 216 | box.hint:=box.hint+#0; 217 | exit; 218 | end; 219 | if (pos(#0+v+#0, box.hint) > 0) 220 | or (box.hint = #0) and (v = box.text) then 221 | exit; // the value is already there 222 | if n > 1 then 223 | begin // add the value to the list of values 224 | box.hint:=box.hint+v+#0; 225 | exit; 226 | end; 227 | box.hint:=box.hint+box.text+#0+v+#0; // init the list of values 228 | box.text:='(more values)'; // message to be shown 229 | // these properties are unhappily kept unaccessible through TcustomEdit interface 230 | try 231 | if box is TLabeledEdit then 232 | (box as Tlabelededit).color := COLOR 233 | except 234 | end; 235 | try 236 | if box is TMemo then 237 | (box as Tmemo).color := COLOR 238 | except 239 | end; 240 | end; // setText 241 | 242 | procedure setCaption(); 243 | const 244 | MAX = 2; 245 | var 246 | a: TStringDynArray; 247 | i: integer; 248 | begin 249 | a := NIL; 250 | if fileTree.SelectionCount > 0 then 251 | for i:=0 to min(fileTree.SelectionCount, MAX)-1 do 252 | addString(fileTree.Selections[i].Text, a); 253 | if fileTree.SelectionCount > MAX then 254 | addString('...', a); 255 | caption:='Properties for '+join(', ', a); 256 | end; // setCaption 257 | 258 | var 259 | act: TfileAction; 260 | actions: set of TfileAction; 261 | begin 262 | firstActionChange := TRUE; 263 | 264 | accountsBox.smallImages := IconsDM.images; 265 | updateAccountsBox(); 266 | 267 | maskTab.tabVisible := FALSE; 268 | diffTab.tabVisible := FALSE; 269 | 270 | iconBox.clear(); 271 | iconBox.Enabled := FALSE; 272 | addiconBtn.Enabled := FALSE; 273 | i := if_(fileTree.SelectionCount > 1, -1, selectedFile.getIconForTreeview(spUseSysIcons in fileSrv.SP)); 274 | iconBox.itemsEx.addItem('Default', i, i, -1, 0, NIL); 275 | iconOfs := iconBox.ItemsEx.count; 276 | for i:=0 to IconsDM.images.Count-1 do 277 | iconBox.itemsEx.addItem(idx_label(i), i, i, -1, 0, NIL); 278 | iconBox.Images := IconsDM.images; 279 | 280 | actions := [FA_ACCESS]; 281 | if fileTree.SelectionCount > 0 then 282 | for i:=0 to fileTree.SelectionCount-1 do 283 | begin 284 | f := fileTree.Selections[i].data; 285 | 286 | setText(f.comment, commentBox); 287 | setText(f.realm, realmBox); 288 | 289 | if f.isRealFolder() then 290 | begin 291 | include(actions, FA_UPLOAD); 292 | setText(f.uploadFilterMask, uploadfilterBox); 293 | end; 294 | 295 | if f.isFileOrFolder() then 296 | setFlag(FA_DONT_LOG, dontlogChk); 297 | 298 | if f.isFile() or f.isRealFolder() then 299 | setFlag(FA_DL_FORBIDDEN, nodlChk); 300 | 301 | if not f.isRoot() then 302 | begin 303 | setFlag(FA_HIDDEN, hiddenChk); 304 | if not iconBox.enabled then 305 | begin 306 | iconBox.enabled:=TRUE; 307 | iconBox.itemIndex := f.icon+iconOfs; 308 | addiconBtn.Enabled:=TRUE; 309 | end 310 | else 311 | if iconBox.itemIndex <> f.icon+iconOfs then 312 | iconBox.itemIndex := -1; 313 | end; 314 | 315 | if f.isFile() then 316 | setFlag(FA_DONT_COUNT_AS_DL, dontconsiderChk); 317 | 318 | if f.isFolder() then 319 | begin 320 | include(actions, FA_DELETE); 321 | 322 | diffTab.tabVisible:=TRUE; 323 | maskTab.tabVisible:=TRUE; 324 | setText(f.filesFilter, filesfilterBox); 325 | setText(f.foldersFilter, foldersfilterBox); 326 | setText(f.defaultFileMask, deffileBox); 327 | setText(f.dontCountAsDownloadMask, dontconsiderBox); 328 | setText(f.diffTpl, difftplBox); 329 | 330 | setFlag(FA_HIDDENTREE, hidetreeChk); 331 | setFlag(FA_HIDE_EXT, hideextChk); 332 | setFlag(FA_BROWSABLE, browsableChk); 333 | setFlag(FA_ARCHIVABLE, archivableChk); 334 | setFlag(FA_HIDE_EMPTY_FOLDERS, hideemptyChk); 335 | 336 | end; 337 | 338 | // collect usernames 339 | for act:=low(act) to high(act) do 340 | addUniqueArray(users[act], f.accounts[act]); 341 | end; 342 | 343 | for act:=low(act) to high(act) do 344 | begin 345 | savePerm[act] := FALSE; 346 | if act in actions then 347 | actionTabs.tabs.add(FILEACTION2STR[act]); 348 | end; 349 | 350 | if mainFrm.easyMode then 351 | onlyForExperts(mainFrm.easyMode, [browsableChk, commentTab, realmBox, dontconsiderChk, maskTab, dontlogChk, hideextChk]); 352 | 353 | actionTabs.tabIndex := 0; 354 | actionTabsChange(NIL); 355 | setCaption(); 356 | pages.TabIndex := 0; 357 | end; 358 | 359 | procedure TfilepropFrm.FormShow(Sender: TObject); 360 | begin 361 | DoShow(mainFrm.filesBox, mainFrm.selectedFile, mainFrm.fileSrv); 362 | end; 363 | 364 | procedure TfilepropFrm.goToAccountsBtnClick(Sender: TObject); 365 | begin 366 | showOptions(optionsFrm.accountsPage, mainfrm.modalOptionsChk.checked); 367 | updateAccountsBox(); 368 | actionTabsChange(NIL); 369 | end; 370 | 371 | procedure TfilepropFrm.allBtnClick(Sender: TObject); 372 | var 373 | i: integer; 374 | b: boolean; 375 | begin 376 | if accountsBox.items.Count = 0 then 377 | exit; 378 | with accountsBox.Items[0] do 379 | begin 380 | b:=not checked; 381 | checked:=b; 382 | end; 383 | for i:=1 to accountsBox.items.count-1 do 384 | accountsBox.Items[i].checked := b; 385 | end; 386 | 387 | procedure TfilepropFrm.anonChkClick(Sender: TObject); 388 | var 389 | s: string; 390 | begin 391 | savePerm[currAction] := TRUE; 392 | if sender = anonChk then 393 | s := USER_ANONYMOUS 394 | else if sender = anyAccChk then 395 | begin 396 | s:=USER_ANY_ACCOUNT; 397 | accountsBox.enabled := not anyAccChk.Checked; 398 | end 399 | else if sender = anyoneChk then 400 | begin 401 | s:=USER_ANYONE; 402 | accountsBox.enabled:=not anyoneChk.Checked; 403 | anonChk.enabled:=accountsBox.enabled; 404 | anyAccChk.enabled:=accountsBox.enabled; 405 | newaccBtn.Enabled:=accountsBox.enabled; 406 | end; 407 | allBtn.Enabled := accountsBox.enabled; 408 | with sender as Tcheckbox do 409 | if checked then 410 | addUniqueString(s, users[currAction]) 411 | else 412 | removeString(s, users[currAction]); 413 | end; 414 | 415 | procedure TfilepropFrm.applyBtnClick(Sender: TObject); 416 | var 417 | i: integer; 418 | f: Tfile; 419 | act: TfileAction; 420 | 421 | procedure applyFlag(flag:TfileAttribute; cb:TCheckBox); 422 | begin 423 | if (cb.State = cbGrayed) 424 | or not cb.Enabled 425 | or not cb.Visible then exit; 426 | 427 | if cb.Checked then 428 | include(f.flags, flag) 429 | else 430 | exclude(f.flags, flag); 431 | end; // applyFlag 432 | 433 | procedure applyText(var v: String; box:TCustomEdit); 434 | begin 435 | if box.modified then 436 | v := box.Text; 437 | end; // applyText 438 | 439 | begin 440 | for act:=low(act) to high(act) do 441 | sortArray(users[act]); 442 | 443 | if mainFrm.filesBox.SelectionCount > 0 then 444 | for i:=0 to mainFrm.filesBox.SelectionCount-1 do 445 | begin 446 | f := mainFrm.filesBox.Selections[i].data; 447 | 448 | for act:=low(act) to high(act) do 449 | if savePerm[act] 450 | and ((act <> FA_UPLOAD) or f.isRealFolder()) 451 | and ((act <> FA_DELETE) or f.isFolder()) then 452 | begin 453 | 454 | // The following is because we monitor every upload path 455 | if (act = FA_UPLOAD) 456 | and ((f.accounts[act] = NIL) <> (users[act] = NIL)) then // something has changed 457 | // WARNING: toggleString() can't be used here, it's not equivalent 458 | if users[act] <> NIL then 459 | addString(f.resource, uploadPaths) 460 | else 461 | removeString(f.resource, uploadPaths); 462 | 463 | f.accounts[act] := users[act]; 464 | end; 465 | 466 | applyText(f.comment, commentBox); 467 | applyText(f.realm, realmBox); 468 | 469 | if f.isFile() then 470 | applyFlag(FA_DONT_COUNT_AS_DL, dontconsiderChk); 471 | 472 | if f.isFolder() then 473 | begin 474 | applyText(f.diffTpl, difftplBox); 475 | applyText(f.filesFilter, filesfilterBox); 476 | applyText(f.foldersFilter, foldersfilterBox); 477 | applyText(f.defaultFileMask, deffileBox); 478 | applyText(f.dontCountAsDownloadMask, dontconsiderBox); 479 | 480 | applyFlag(FA_HIDDENTREE, hidetreeChk); 481 | applyFlag(FA_HIDE_EXT, hideextChk); 482 | applyFlag(FA_HIDE_EMPTY_FOLDERS, hideemptyChk); 483 | applyFlag(FA_BROWSABLE, browsableChk); 484 | applyFlag(FA_ARCHIVABLE, archivableChk); 485 | end; 486 | 487 | if not f.isRoot() then 488 | begin 489 | applyFlag(FA_HIDDEN, hiddenChk); 490 | if iconBox.itemIndex > -1 then 491 | f.setupImage(mainfrm.useSystemIconsChk.checked, iconBox.itemIndex-iconOfs); 492 | end; 493 | 494 | if f.isRealFolder() then 495 | applyText(f.uploadFilterMask, uploadfilterBox); 496 | 497 | if f.isFileOrFolder() then 498 | applyFlag(FA_DONT_LOG, dontlogChk); 499 | 500 | if f.isFile() or f.isRealFolder() then 501 | applyFlag(FA_DL_FORBIDDEN, nodlChk); 502 | end; 503 | end; 504 | 505 | procedure TfilepropFrm.newaccBtnClick(Sender: TObject); 506 | var 507 | acc: Paccount; 508 | begin 509 | acc := createAccountOnTheFly(); 510 | if acc = NIL then 511 | exit; 512 | with accountsBox.Items.add() do 513 | begin 514 | caption:=acc.user; 515 | data:=acc; 516 | checked:=TRUE; 517 | end; 518 | end; 519 | 520 | procedure TfilepropFrm.textinputEnter(Sender: TObject); 521 | 522 | function chooseValue(var s:string):boolean; 523 | var 524 | l: string; 525 | begin 526 | l:=s; 527 | repeat s:=chop(#0, l) 528 | until (s > '') or (l = ''); 529 | result:=TRUE; 530 | end; // chooseValue 531 | 532 | var 533 | box: TcustomEdit; 534 | s, h: string; 535 | begin 536 | box:=sender as TcustomEdit; 537 | if countSubstr(#0, box.hint) < 2 then exit; 538 | 539 | s:=box.hint; 540 | h:=chop(#0, s); 541 | if not chooseValue(s) then exit; 542 | box.text:=s; 543 | box.hint:=h; 544 | // these properties are unhappily kept unaccessible through TcustomEdit interface 545 | try (box as Tlabelededit).color:=clWindow except end; 546 | try (box as Tmemo).color:=clWindow except end; 547 | end; 548 | 549 | procedure TfilepropFrm.updateAccountsBox; 550 | var 551 | i: integer; 552 | a: Paccount; 553 | begin 554 | accountsBox.clear(); 555 | for i:=0 to length(accounts)-1 do 556 | begin 557 | a:=@accounts[i]; 558 | if not a.enabled then 559 | continue; 560 | accountsBox.addItem(a.user, Tobject(a)); 561 | end; 562 | end; // updateAccountsBox 563 | 564 | end. 565 | -------------------------------------------------------------------------------- /hfs.dpr: -------------------------------------------------------------------------------- 1 | { 2 | Copyright (C) 2002-2014 Massimo Melina (www.rejetto.com) 3 | 4 | This file is part of HFS ~ HTTP File Server. 5 | 6 | HFS is free software; you can redistribute it and/or modify 7 | it under the terms of the GNU General Public License as published by 8 | the Free Software Foundation; either version 2 of the License, or 9 | (at your option) any later version. 10 | 11 | HFS is distributed in the hope that it will be useful, 12 | but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | GNU General Public License for more details. 15 | 16 | You should have received a copy of the GNU General Public License 17 | along with HSG; if not, write to the Free Software 18 | Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 19 | } 20 | {$INCLUDE defs.inc } 21 | { $SetPEOptFlags $100 } //IMAGE_DLLCHARACTERISTICS_NX_COMPAT 22 | {$SETPEOPTFLAGS $140} // NX + ASLR 23 | {$STRINGCHECKS OFF} 24 | program hfs; 25 | 26 | {$R 'data.res' 'res\data.rc'} 27 | 28 | uses 29 | {$IFDEF EX_DEBUG} 30 | ftmExceptionForm, 31 | {$ENDIF } 32 | Forms, 33 | windows, 34 | types, 35 | hsLib in 'srv\hsLib.pas', 36 | RDUtils, 37 | sysUtils, 38 | main in 'main.pas' {mainFrm}, 39 | newuserpassDlg in 'newuserpassDlg.pas' {newuserpassFrm}, 40 | optionsDlg in 'optionsDlg.pas' {optionsFrm}, 41 | utillib in 'utillib.pas', 42 | monoLib in 'lib\monoLib.pas', 43 | regexpr in 'lib\regexpr.pas', 44 | longinputDlg in 'lib\longinputDlg.pas' {longinputFrm}, 45 | folderKindDlg in 'lib\folderKindDlg.pas' {folderKindFrm}, 46 | shellExtDlg in 'lib\shellExtDlg.pas' {shellExtFrm}, 47 | diffDlg in 'lib\diffDlg.pas' {diffFrm}, 48 | purgeDlg in 'lib\purgeDlg.pas' {purgeFrm}, 49 | ipsEverDlg in 'ipsEverDlg.pas' {ipsEverFrm}, 50 | HSUtils in 'srv\HSUtils.pas', 51 | parserLib in 'srv\parserLib.pas', 52 | scriptLib in 'srv\scriptLib.pas', 53 | fileLib in 'srv\fileLib.pas', 54 | srvUtils in 'srv\srvUtils.pas', 55 | serverLib in 'srv\serverLib.pas', 56 | IconsLib in 'srv\IconsLib.pas' {IconsDM: TDataModule}, 57 | srvClassesLib in 'srv\srvClassesLib.pas', 58 | srvConst in 'srv\srvConst.pas', 59 | srvVars in 'srv\srvVars.pas', 60 | netUtils in 'srv\netUtils.pas', 61 | listSelectDlg in 'listSelectDlg.pas' {listSelectFrm}, 62 | filepropDlg in 'filepropDlg.pas' {filepropFrm}, 63 | runscriptDlg in 'runscriptDlg.pas' {runScriptFrm}, 64 | hfsJclOthers in 'jcl\hfsJclOthers.pas', 65 | hfsGlobal in 'hfsGlobal.pas', 66 | hfsVars in 'hfsVars.pas', 67 | langLib in 'langLib.pas', 68 | progFrmLib in 'lib\progFrmLib.pas', 69 | hfs.tray in 'hfs.tray.pas', 70 | HFS.Macroses in 'HFS.Macroses.pas'; 71 | 72 | {$R *.res} 73 | 74 | procedure processSlaveParams(const params: String); 75 | var 76 | ss: TStringDynArray; 77 | begin 78 | if mainfrm = NIL then 79 | exit; 80 | ss := split(#13, params); 81 | processParams_before(ss); 82 | mainfrm.processParams_after(ss); 83 | end; 84 | 85 | function isSingleInstance(): boolean; 86 | var 87 | params: TStringDynArray; 88 | ini, tpl: string; 89 | begin 90 | result := FALSE; 91 | // the -i parameter affects loadCfg() 92 | params := paramsAsArray(); 93 | processParams_before(params, 'i'); 94 | loadCfg(ini, tpl); 95 | chop('only-1-instance=', ini); 96 | if ini = '' then 97 | exit; 98 | ini := chopLine(ini); 99 | result := sameText(ini, 'yes'); 100 | end; // isSingleInstance 101 | 102 | begin 103 | mono.onSlaveParams := processSlaveParams; 104 | if not holdingKey(VK_CONTROL) then 105 | begin 106 | if not mono.init('HttpFileServer') then 107 | begin 108 | msgDlg('monoLib error: '+mono.error, MB_ICONERROR+MB_OK); 109 | halt(1); 110 | end; 111 | if not mono.master and isSingleInstance() then 112 | begin 113 | mono.sendParams(); 114 | exit; 115 | end; 116 | end; 117 | {$IFDEF EX_DEBUG}initErrorHandler(format('HFS %s (%s)', [VERSION, VERSION_BUILD]));{$ENDIF} 118 | Application.Initialize(); 119 | Application.CreateForm(TIconsDM, IconsDM); 120 | Application.CreateForm(TmainFrm, mainFrm); 121 | Application.CreateForm(TnewuserpassFrm, newuserpassFrm); 122 | Application.CreateForm(ToptionsFrm, optionsFrm); 123 | Application.CreateForm(TdiffFrm, diffFrm); 124 | Application.CreateForm(TipsEverFrm, ipsEverFrm); 125 | Application.CreateForm(TrunScriptFrm, runScriptFrm); 126 | mainfrm.finalInit(); 127 | Application.Run; 128 | {$IFDEF EX_DEBUG}closeErrorHandler();{$ENDIF} 129 | end. 130 | -------------------------------------------------------------------------------- /hfs.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/drapid/HFS/06a40abe58c47b63bbe60fd63767d33c123d8d44/hfs.res -------------------------------------------------------------------------------- /hfs.tray.pas: -------------------------------------------------------------------------------- 1 | unit HFS.Tray; 2 | {$I NoRTTI.inc} 3 | 4 | interface 5 | 6 | uses 7 | Windows, 8 | {$IFDEF FPC} 9 | SysUtils, Classes, Graphics, 10 | ImgList, 11 | IntfGraphics, 12 | {$ELSE} 13 | System.SysUtils, System.Classes, System.ImageList, 14 | Graphics, Vcl.ImgList, 15 | Vcl.BaseImageCollection, Vcl.ImageCollection, 16 | Vcl.Imaging.pngImage, 17 | Vcl.VirtualImageList, 18 | {$ENDIF FPC} 19 | Controls, CommCtrl 20 | ; 21 | const 22 | iconsBaseSize = 16; 23 | type 24 | TIconParams = record 25 | isActive: Boolean; 26 | perc: real; 27 | size: Integer; 28 | str: String; 29 | end; 30 | 31 | procedure drawTrayIconNumber(cnv: TCanvas; const s: String; size: Integer = iconsBaseSize); OverLoad; 32 | procedure drawTrayIconNumber(cnv: TCanvas; const n: Integer; size: Integer = iconsBaseSize); OverLoad; 33 | function getBaseTrayIcon(isSrvActive: Boolean; perc: real=0; size: Integer = iconsBaseSize): TBitmap; 34 | function setTrayIcon(var ti: TIcon; const prevParams: TIconParams; params: TIconParams): Boolean; OverLoad; 35 | procedure setTrayIcon(var ti: TIcon; isSrvActive: Boolean; perc: real=0; size: Integer = iconsBaseSize; str: String = ''); OverLoad; 36 | 37 | var 38 | tray_ico: Ticon; // the actual icon shown in tray 39 | main_ico_params: TIconParams; 40 | 41 | implementation 42 | 43 | uses 44 | {$IFDEF UNICODE} 45 | AnsiClasses, ansiStrings, 46 | {$ENDIF UNICODE} 47 | {$IFDEF FPC} 48 | LazCanvas, GraphType, 49 | {$ELSE ~FPC} 50 | WinApi.ShellAPI, 51 | {$ENDIF ~FPC} 52 | // utilLib, 53 | RDUtils, 54 | iconsLib, 55 | srvVars, srvUtils; 56 | 57 | {$IFNDEF FPC} 58 | var 59 | numbers: TBitmap; 60 | {$ENDIF ~FPC} 61 | 62 | function getBaseTrayIcon(isSrvActive: Boolean; perc: real=0; size: Integer = iconsBaseSize): TBitmap; 63 | var 64 | x: integer; 65 | h, h2: Integer; 66 | begin 67 | Result := IconsDM.GetBitmap( if_(isSrvActive, 24, 30), size); 68 | if perc > 0 then 69 | begin 70 | h := Result.Height; 71 | x := round((h-2)*perc); 72 | h2 := h div 2 + 1; 73 | result.canvas.Brush.color := clYellow; 74 | result.Canvas.FillRect(rect(1, h2, x+1, h-1)); 75 | result.canvas.Brush.color := clGreen; 76 | result.Canvas.FillRect(rect(x+1,h2,h-1, h-1)); 77 | end; 78 | end; // getBaseTrayIcon 79 | 80 | procedure drawTrayIconNumber(cnv: TCanvas; const n: Integer; size: Integer = iconsBaseSize); 81 | begin 82 | drawTrayIconNumber(cnv, intToStr(n), size); 83 | end; 84 | 85 | {$IFNDEF FPC} 86 | procedure drawTrayIconNumber(cnv: TCanvas; const s: String; size: Integer = iconsBaseSize); 87 | 88 | var 89 | w, h, idx: integer; 90 | dx, dy, dw, dh: Integer; 91 | blend: BLENDFUNCTION; 92 | MaskDC: HDC; 93 | Save: THandle; 94 | begin 95 | if length(s) > 0 then 96 | begin 97 | dx := 10; 98 | dy := 8; 99 | w := numbers.Width div 11; 100 | h := numbers.Height; 101 | dx := MulDiv(dx, size, iconsBaseSize); 102 | dy := MulDiv(dy, size, iconsBaseSize); 103 | dw := MulDiv(4, size, iconsBaseSize); 104 | dh := MulDiv(6, size, iconsBaseSize); 105 | for var i:=length(s) downto 1 do 106 | begin 107 | if s[i] = '%' then 108 | idx:=10 109 | else 110 | idx:=ord(s[i])-ord('0'); 111 | if numbers.Transparent then 112 | begin 113 | Save := 0; 114 | MaskDC := 0; 115 | try 116 | MaskDC := CreateCompatibleDC(0); 117 | Save := SelectObject(MaskDC, numbers.MaskHandle); 118 | TransparentStretchBlt(cnv.Handle, dx, dy, dw, dh, numbers.Canvas.Handle, idx*w, 0, w, h, MaskDC, idx*w, 0); 119 | finally 120 | if Save <> 0 then SelectObject(MaskDC, Save); 121 | if MaskDC <> 0 then DeleteDC(MaskDC); 122 | end; 123 | end 124 | else 125 | {$IFDEF FPC} 126 | if numbers.PixelFormat = pf32bit then 127 | {$ELSE ~FPC} 128 | if numbers.SupportsPartialTransparency then 129 | {$ENDIF FPC} 130 | begin 131 | blend.AlphaFormat := AC_SRC_ALPHA 132 | ; 133 | blend.BlendOp := AC_SRC_OVER; 134 | blend.BlendFlags := 0; 135 | blend.SourceConstantAlpha := $FF; 136 | AlphaBlend(cnv.Handle, dx, dy, dw, dh, numbers.Canvas.Handle, 137 | idx*w, 0, w, h, blend); 138 | end 139 | else 140 | TransparentBlt(cnv.Handle, dx, dy, dw, dh, numbers.Canvas.Handle, idx*w, 0, w, h, $FF00FF); 141 | dec(dx, dw); 142 | end; 143 | end; 144 | end; // drawTrayIconString 145 | 146 | {$ELSE FPC} 147 | procedure drawTrayIconNumber(cnv: TCanvas; const s: String; size: Integer = iconsBaseSize); 148 | 149 | var 150 | w, h, idx: integer; 151 | dx, dy, dw, dh: Integer; 152 | i: Integer; 153 | begin 154 | if length(s) > 0 then 155 | begin 156 | dx := 10; 157 | dy := 8; 158 | w := iconsLib.IconsDM.numbers.Width div 11; 159 | h := iconsLib.IconsDM.numbers.Height; 160 | dx := MulDiv(dx, size, iconsBaseSize); 161 | dy := MulDiv(dy, size, iconsBaseSize); 162 | dw := MulDiv(4, size, iconsBaseSize); 163 | dh := MulDiv(6, size, iconsBaseSize); 164 | for i:=length(s) downto 1 do 165 | begin 166 | if s[i] = '%' then 167 | idx:=10 168 | else 169 | idx:=ord(s[i])-ord('0'); 170 | if size = iconsBaseSize then 171 | iconsLib.IconsDM.numbers.Draw(cnv, dx, dy, idx) 172 | else 173 | iconsLib.IconsDM.numbers.StretchDraw(cnv, idx, TRect.Create(Point(dx, dy), dw, dh)); 174 | dec(dx, dw); 175 | end; 176 | end; 177 | end; // drawTrayIconString 178 | {$ENDIF FPC} 179 | 180 | procedure setTrayIcon(var ti: TIcon; isSrvActive: Boolean; perc: real=0; size: Integer = iconsBaseSize; str: String = ''); 181 | var 182 | bmp: Tbitmap; 183 | xx: Integer; 184 | begin 185 | {$IFDEF FPC} 186 | ti.Clear; 187 | for xx in [16, 32] do 188 | {$ELSE ~FPC} 189 | xx := size; 190 | {$ENDIF FPC} 191 | begin 192 | bmp := getBaseTrayIcon(isSrvActive, perc, xx); 193 | if str <> '' then 194 | begin 195 | drawTrayIconNumber(bmp.canvas, str, size); 196 | end; 197 | // data.tray_ico.Handle := bmpToHico(bmp); 198 | //ti.Handle := bmp2ico32(bmp); 199 | {$IFDEF FPC} 200 | ti.Add(bmp.PixelFormat, xx, xx); 201 | //tray_ico.Add(pf32bit, bmp.Height, bmp.Width); 202 | ti.Current := ti.Count-1; 203 | ti.AssignImage(bmp); 204 | {$ELSE ~FPC} 205 | ti.Handle := bmp2ico32(bmp); 206 | //tray_ico.Handle := bmp2ico4M(bmp); 207 | {$ENDIF FPC} 208 | bmp.free; 209 | end; 210 | {$IFDEF FPC} 211 | ti.Current := ti.GetBestIndexForSize(TSize.Create(Size, Size)); 212 | {$ENDIF FPC} 213 | end; 214 | 215 | function setTrayIcon(var ti: TIcon; const prevParams: TIconParams; params: TIconParams): Boolean; 216 | begin 217 | if (prevParams.isActive = params.isActive) and 218 | (prevParams.perc = params.perc) and 219 | (prevParams.size = params.size) and 220 | (prevParams.str = params.str) 221 | then 222 | Exit(false); 223 | 224 | setTrayIcon(ti, params.isActive, params.perc, params.size, params.str); 225 | // prevParams.isActive := params.isActive; 226 | // prevParams.perc := params.perc; 227 | // prevParams.size := params.size; 228 | // prevParams.str := params.str; 229 | Result := True; 230 | end; 231 | 232 | {$IFNDEF FPC} 233 | 234 | INITIALIZATION 235 | var 236 | snum: RawByteString; 237 | begin 238 | snum := getRes('NUMBERS32', 'IMAGE'); 239 | if snum = '' then 240 | snum := getRes('NUMBERS', 'IMAGE'); 241 | numbers := stringPNG2BMP(snum); 242 | snum := ''; 243 | end; 244 | {$ENDIF ~FPC} 245 | 246 | end. 247 | -------------------------------------------------------------------------------- /hfsGlobal.pas: -------------------------------------------------------------------------------- 1 | unit hfsGlobal; 2 | {$I NoRTTI.inc} 3 | 4 | interface 5 | uses 6 | System.UITypes, 7 | Graphics, 8 | Types, SysUtils, srvConst; 9 | 10 | const 11 | {$I RnQBuiltTime.inc} 12 | CRLF = #13#10; 13 | CRLFA = RawByteString(#13#10); 14 | TAB = #9; 15 | BAK_EXT = '.bak'; 16 | CFG_KEY = 'Software\rejetto\HFS'; 17 | CFG_FILE = 'hfs.ini'; 18 | TPL_FILE = 'hfs.tpl'; 19 | IPS_FILE = 'hfs.ips.txt'; 20 | VFS_TEMP_FILE = '~temp.vfs'; 21 | EVENTSCRIPTS_FILE = 'hfs.events'; 22 | PREVIOUS_VERSION = 'hfs.old.exe'; 23 | IPS_THRESHOLD = 50; // used to avoid an external file for few IPs (ipsEverConnected list) 24 | STATUSBAR_REFRESH = 10; // tenth of second 25 | MAX_RECENT_FILES = 5; 26 | MANY_ITEMS_THRESHOLD = 1000; 27 | YESNO: array [boolean] of string=('no','yes'); 28 | // LIBS_DOWNLOAD_URL = 'http://rejetto.com/hfs/'; 29 | LIBS_DOWNLOAD_URL = 'http://libs.rnq.ru/'; 30 | HFS_GUIDE_URL = 'http://www.rejetto.com/hfs/guide/'; 31 | 32 | ALWAYS_ON_WEB_SERVER = 'google.com'; 33 | ADDRESS_COLOR = TColors.Green; 34 | BG_ERROR = $BBBBFF; 35 | TRAY_ICON_SIZE = 32; 36 | 37 | // messages 38 | resourcestring 39 | S_PORT_LABEL = 'Port: %s'; 40 | S_PORT_ANY = 'any'; 41 | DISABLED = 'disabled'; 42 | MSG_OK = 'Ok'; 43 | // messages 44 | MSG_MENU_VAL = ' (%s)'; 45 | MSG_DL_TIMEOUT = 'No downloads timeout'; 46 | MSG_MAX_CON = 'Max connections'; 47 | MSG_MAX_CON_SING = 'Max connections from single address'; 48 | MSG_MAX_SIM_ADDR = 'Max simultaneous addresses'; 49 | MSG_MAX_SIM_ADDR_DL = 'Max simultaneous addresses downloading'; 50 | MSG_MAX_SIM_DL_SING = 'Max simultaneous downloads from single address'; 51 | MSG_MAX_SIM_DL = 'Max simultaneous downloads'; 52 | MSG_SET_LIMIT = 'Set limit'; 53 | MSG_UNPROTECTED_LINKS = 'Links are NOT actually protected.' 54 | +#13'The feature is there to be used with the "list protected items only..." option.' 55 | +#13'Continue?'; 56 | MSG_SAME_NAME ='An item with the same name is already present in this folder.' 57 | +#13'Continue?'; 58 | MSG_CONTINUE = 'Continue?'; 59 | MSG_PROCESSING = 'Processing...'; 60 | MSG_OPTIONS_SAVED = 'Options saved'; 61 | MSG_SOME_LOCKED = 'Some items were not affected because locked'; 62 | MSG_ITEM_LOCKED = 'The item is locked'; 63 | MSG_INVALID_VALUE = 'Invalid value'; 64 | MSG_EMPTY_NO_LIMIT = 'Leave blank to get no limits.'; 65 | MSG_ADDRESSES_EXCEED = 'The following addresses exceed the limit:'#13'%s'; 66 | MSG_NO_TEMP = 'Cannot save temporary file'; 67 | MSG_ERROR_REGISTRY = 'Can''t write to registry.' 68 | +#13'You may lack necessary rights.'; 69 | MSG_MANY_ITEMS = 'You are putting many files.' 70 | +#13'Try using real folders instead of virtual folders.' 71 | +#13'Read documentation or ask on the forum for help.'; 72 | MSG_ADD_TO_HFS = '"Add to HFS" has been added to your Window''s Explorer right-click menu.'; 73 | MSG_SINGLE_INSTANCE = 'Sorry, this feature only works with the "Only 1 instance" option enabled.' 74 | +#13#13'You can find this option under Menu -> Start/Exit' 75 | +#13'(only in expert mode)'; 76 | MSG_ENABLED = 'Option enabled'; 77 | MSG_DISABLED = 'Option disabled'; 78 | MSG_COMM_ERROR = 'Network error. Request failed.'; 79 | MSG_CON_PAUSED = 'paused'; 80 | MSG_CON_SENT = '%s / %s sent'; 81 | MSG_CON_RECEIVED = '%s / %s received'; 82 | 83 | type 84 | 85 | // Pboolean = ^boolean; 86 | 87 | TfilterMethod = function(self: Tobject): Boolean; 88 | 89 | Thelp = ( HLP_NONE, HLP_TPL ); 90 | 91 | type 92 | TTrayShows = (TS_downloads, TS_connections, TS_uploads, TS_hits, TS_ips, TS_ips_ever, TS_none); 93 | 94 | implementation 95 | 96 | end. 97 | -------------------------------------------------------------------------------- /hfsVars.pas: -------------------------------------------------------------------------------- 1 | unit hfsVars; 2 | {$I NoRTTI.inc} 3 | 4 | interface 5 | uses 6 | Graphics, 7 | // Forms, 8 | Controls, 9 | ComCtrls, 10 | Classes, Types, iniFiles, hsLib, srvClassesLib, hfsGlobal; 11 | 12 | // global variables 13 | var 14 | // srv: ThttpSrv; 15 | // globalLimiter: TspeedLimiter; 16 | // ip2obj: THashedStringList; 17 | // sessions: Tsessions; 18 | // etags: THashedStringList; 19 | cfgLoaded: boolean; 20 | addToFolder: string; // default folder where to add items from the command line 21 | lastDialogFolder: UnicodeString; // stores last for open dialog, to make it persistent 22 | clock: integer; // program ticks (tenths of second) 23 | // workaround for splitters' bad behaviour 24 | lastGoodLogWidth, lastGoodConnHeight: integer; 25 | usingFreePort: boolean=TRUE; // the actual server port set was 0 26 | // upTime: Tdatetime; // the server is up since... 27 | trayed: boolean; // true if the window has been minimized to tray 28 | addFolderDefault: string; // how to default adding a folder (real/virtual) 29 | // autoFingerprint: integer; // create fingerprint on file addition 30 | altPressedForMenu: boolean; // used to enable the menu on ALT key 31 | noDownloadTimeout: integer; // autoclose the application after (minutes) 32 | connectionsInactivityTimeout: integer; // autokick connection after (seconds) 33 | lastUpdateCheck: Tdatetime; 34 | lastUpdateCheckFN: string; // eventual temp file for saving lastUpdateCheck 35 | recentFiles: TStringDynArray; // recently loaded files 36 | addingItemsCounter: integer = -1; // -1 is disabled 37 | // stopAddingItems, 38 | queryingClose: boolean; 39 | // tpl_help: string; 40 | lastWindowRect: Trect; 41 | tplEditor: UnicodeString; 42 | tplLast: Tdatetime; 43 | tplImport: boolean; 44 | eventScriptsLast, runScriptLast: Tdatetime; 45 | graphInEasyMode: boolean; 46 | logMaxLines: integer; // number of lines 47 | windowsShuttingDown: boolean = FALSE; 48 | quitASAP: boolean; // deferred quit 49 | quitting: boolean; // ladies, we're quitting 50 | scrollFilesBox: integer = -1; 51 | defaultCfg: string; 52 | tplIsCustomized: boolean; 53 | fakingMinimize: boolean; // user clicked the [X] but we simulate the [_] 54 | loginRealm: string; 55 | serializedConnColumns: string; 56 | logFontName: string; 57 | logFontSize: integer; 58 | applicationFullyInitialized: boolean; 59 | lockTimerevent: boolean; 60 | logRightClick: Tpoint; 61 | warnManyItems: boolean = TRUE; 62 | startupFilename: string; 63 | trustedFiles, filesToAddQ: TstringDynArray; 64 | backuppedCfg: string; 65 | refusedUpdate: string; 66 | updateWaiting: string; 67 | filesBoxRatio: real; 68 | fromTray: boolean; // used to notify about an eventy happening from a tray action 69 | userInteraction: record 70 | disabled: boolean; 71 | bakVisible: boolean; // backup value for mainFrm.visible 72 | end; 73 | userIcsBuffer, userSocketBuffer: integer; 74 | searchLogTime, searchLogWhiteTime, timeTookToSearchLog: TdateTime; 75 | sbarTextTimeout: Tdatetime; 76 | sbarIdxs: record // indexes within the statusbar 77 | totalIn, totalOut, banStatus, customTpl, oos, out, notSaved: integer; 78 | end; 79 | cachedIPs: String; // To optimize 80 | 81 | const 82 | // UPDATE_URL = 'https://www.rejetto.com/hfs/hfs.updateinfo.txt'; 83 | {$IFDEF WIN64} 84 | UPDATE_URL = 'http://rnq.ru/HFS/hfs.updateinfo.x64.txt'; 85 | {$ELSE WIN32} 86 | UPDATE_URL = 'http://rnq.ru/HFS/hfs.updateinfo.txt'; 87 | {$ENDIF} 88 | const 89 | UPDATE_ON_DISK = 'hfs.updateinfo.txt'; 90 | 91 | const 92 | trayShowCode: array[TTrayShows] of string = ('downloads', 'connections', 'uploads', 'hits', 'ips', 'ips-ever', ''); 93 | var 94 | // trayShows: string; // describes the content of the tray icon 95 | trayShows: TTrayShows; // describes the content of the tray icon 96 | 97 | function strToTrayShow(const s: String): TTrayShows; 98 | 99 | implementation 100 | 101 | function strToTrayShow(const s: String): TTrayShows; 102 | begin 103 | if s = 'connections' then 104 | Exit(TS_connections) 105 | else if s = 'downloads' then 106 | Exit(TS_downloads) 107 | else if s = 'uploads' then 108 | Exit(TS_uploads) 109 | else if s = 'hits' then 110 | Exit(TS_hits) 111 | else if s = 'ips' then 112 | Exit(TS_ips) 113 | else if s = 'ips-ever' then 114 | Exit(TS_ips_ever); 115 | Result := TS_none; 116 | end; 117 | 118 | 119 | end. 120 | -------------------------------------------------------------------------------- /ipsEverDlg.dfm: -------------------------------------------------------------------------------- 1 | object ipsEverFrm: TipsEverFrm 2 | Left = 0 3 | Top = 0 4 | BorderStyle = bsDialog 5 | Caption = 'Addresses ever connected' 6 | ClientHeight = 261 7 | ClientWidth = 286 8 | Color = clBtnFace 9 | Constraints.MaxHeight = 300 10 | Constraints.MinHeight = 300 11 | Font.Charset = DEFAULT_CHARSET 12 | Font.Color = clWindowText 13 | Font.Height = -11 14 | Font.Name = 'Tahoma' 15 | Font.Style = [] 16 | Position = poMainFormCenter 17 | OnShow = FormShow 18 | DesignSize = ( 19 | 286 20 | 261) 21 | TextHeight = 13 22 | object totalLbl: TLabel 23 | Left = 197 24 | Top = 246 25 | Width = 61 26 | Height = 13 27 | Anchors = [akLeft] 28 | Caption = 'Total label...' 29 | end 30 | object ipsBox: TMemo 31 | Left = 0 32 | Top = 0 33 | Width = 286 34 | Height = 236 35 | Align = alTop 36 | Anchors = [akLeft, akTop, akRight, akBottom] 37 | ReadOnly = True 38 | ScrollBars = ssVertical 39 | TabOrder = 0 40 | end 41 | object resetBtn: TButton 42 | Left = 114 43 | Top = 241 44 | Width = 75 45 | Height = 25 46 | Anchors = [akLeft] 47 | Caption = '&Reset' 48 | TabOrder = 1 49 | OnClick = resetBtnClick 50 | end 51 | object editBtn: TButton 52 | Left = 8 53 | Top = 241 54 | Width = 95 55 | Height = 25 56 | Anchors = [akLeft] 57 | Caption = '&Open in editor' 58 | TabOrder = 2 59 | OnClick = editBtnClick 60 | end 61 | end 62 | -------------------------------------------------------------------------------- /ipsEverDlg.pas: -------------------------------------------------------------------------------- 1 | unit ipsEverDlg; 2 | 3 | interface 4 | 5 | uses 6 | Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 7 | Dialogs, StdCtrls; 8 | 9 | type 10 | TipsEverFrm = class(TForm) 11 | ipsBox: TMemo; 12 | resetBtn: TButton; 13 | totalLbl: TLabel; 14 | editBtn: TButton; 15 | procedure resetBtnClick(Sender: TObject); 16 | procedure FormShow(Sender: TObject); 17 | procedure editBtnClick(Sender: TObject); 18 | private 19 | { Private declarations } 20 | public 21 | procedure refreshData(); 22 | { Public declarations } 23 | end; 24 | 25 | var 26 | ipsEverFrm: TipsEverFrm; 27 | 28 | implementation 29 | 30 | {$R *.dfm} 31 | 32 | uses 33 | main, srvVars, utilLib, hfsGlobal; 34 | 35 | procedure TipsEverFrm.resetBtnClick(Sender: TObject); 36 | begin 37 | ipsEverConnected.clear(); 38 | refreshData(); 39 | end; 40 | 41 | procedure TipsEverFrm.editBtnClick(Sender: TObject); 42 | var 43 | fn: string; 44 | begin 45 | fn:=saveTempFile(ipsEverConnected.text); 46 | if renameFile(fn, fn+'.txt') then 47 | exec(fn+'.txt') 48 | else 49 | msgDlg(MSG_NO_TEMP, MB_ICONERROR); 50 | end; 51 | 52 | procedure TipsEverFrm.FormShow(Sender: TObject); 53 | begin refreshData() end; 54 | 55 | procedure TipsEverFrm.refreshData(); 56 | begin 57 | ipsBox.text := ipsEverConnected.text; 58 | totalLbl.caption := format('Total: %d', [ipsEverConnected.count]); 59 | repaintTray(mainFrm.fileSrv); 60 | end; // refreshData 61 | 62 | end. 63 | -------------------------------------------------------------------------------- /langLib.pas: -------------------------------------------------------------------------------- 1 | { 2 | Copyright (C) 2002-2004 Massimo Melina (www.rejetto.com) 3 | 4 | This file is part of &RQ. 5 | 6 | &RQ is free software; you can redistribute it and/or modify 7 | it under the terms of the GNU General Public License as published by 8 | the Free Software Foundation; either version 2 of the License, or 9 | (at your option) any later version. 10 | 11 | &RQ is distributed in the hope that it will be useful, 12 | but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | GNU General Public License for more details. 15 | 16 | You should have received a copy of the GNU General Public License 17 | along with &RQ; if not, write to the Free Software 18 | Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 19 | } 20 | unit langLib; 21 | {$I forRnQConfig.inc} 22 | {$INCLUDE defs.inc } 23 | {$I NoRTTI.inc} 24 | 25 | interface 26 | 27 | uses 28 | RnQLangs, classes, forms; 29 | 30 | procedure translateWindows; 31 | procedure translateWindow(w: Tform); 32 | procedure translateComponent(c: Tcomponent; window: Tform); 33 | 34 | implementation 35 | 36 | uses 37 | utilLib, SyncObjs, ComCtrls, // CheckLst, 38 | // RQUtil, 39 | RDGlobal, 40 | Types, stdctrls, ExtCtrls, menus, controls, sysUtils, strUtils; 41 | 42 | 43 | 44 | function trans(const s: String): String; {$IFDEF HAS_INLINE} inline; {$ENDIF HAS_INLINE} 45 | begin 46 | {if AnsiStartsStr('___',s) then 47 | result:=getTranslation(copy(s,4,9999)) 48 | else 49 | } 50 | // if useLang and Assigned(LangVar) then 51 | result := getTranslation(s); 52 | end; // trans 53 | 54 | (*procedure trans2(var s: String); inline; 55 | begin 56 | {if AnsiStartsStr('___',s) then 57 | result:=getTranslation(copy(s,4,9999)) 58 | else 59 | } 60 | s := getTranslation(s); 61 | end; // trans*) 62 | 63 | type 64 | TLangControl = class(TControl) 65 | property Caption; 66 | end; 67 | 68 | procedure translateComponent(c: Tcomponent; window: Tform); 69 | 70 | procedure recurMenu(it: Tmenuitem); 71 | var 72 | i: integer; 73 | begin 74 | it.caption := trans(it.caption); 75 | it.hint := trans(it.hint); 76 | with it do 77 | for i:=0 to count-1 do 78 | recurMenu(items[i]); 79 | end; // recurMenu 80 | 81 | { procedure recurTree(t: Ttreenode); overload; 82 | var 83 | i: integer; 84 | begin 85 | t.text := trans(t.text); 86 | for i:=0 to t.count-1 do 87 | recurTree(t.item[i]); 88 | end; // recurTree 89 | } 90 | { procedure recurTree(t: Ttreenodes); overload; 91 | var 92 | i: integer; 93 | begin 94 | for i:=0 to t.count-1 do 95 | recurTree(t.item[i]); 96 | end; // recurTree 97 | } 98 | procedure tstrings_trans(s: Tstrings); 99 | var 100 | i: integer; 101 | begin 102 | for i:=0 to s.count-1 do 103 | s[i] := trans(s[i]); 104 | end; // tstrings_trans 105 | var 106 | i, k: integer; 107 | {$IFDEF FPC} 108 | cc: TCollectionItem; 109 | {$ENDIF FPC} 110 | begin 111 | if c is Tmenu then 112 | with c as Tmenu do 113 | recurMenu(items) 114 | else if c is Tlabelededit then 115 | with c as Tlabelededit do 116 | with editlabel do 117 | caption := trans(caption) 118 | else if c is Tradiogroup then 119 | with c as Tradiogroup do 120 | begin 121 | caption := trans(caption); 122 | tstrings_trans(items); 123 | end 124 | else if c is TcomboBox then 125 | with TcomboBox(c) do 126 | begin // itemindex is lost during translation 127 | i := itemIndex; 128 | k := Items.Count; 129 | if k > 0 then 130 | begin 131 | tstrings_trans(items); 132 | itemIndex := i; 133 | end; 134 | end 135 | else if c is TListView then 136 | begin // itemindex is lost during translation 137 | for {$IFNDEF FPC}var{$ENDIF ~FPC} cc in TListView(c).Columns do 138 | TListColumn(cc).Caption := trans(TListColumn(cc).Caption) 139 | end 140 | { else if c is TVirtualDrawTree then 141 | begin 142 | for I := 0 to TVirtualDrawTree(c).Header.Columns.Count - 1 do 143 | TVirtualDrawTree(c).Header.Columns.Items[i].Text := 144 | getTranslation(TVirtualDrawTree(c).Header.Columns.Items[i].Text) 145 | end 146 | } 147 | { 148 | else if c is Tchecklistbox then with c as Tchecklistbox do 149 | tstrings_trans(items) 150 | } 151 | else if c is TControl then 152 | with TLangControl(c) do 153 | begin 154 | hint := trans(hint); 155 | if caption > '' then 156 | caption := trans(caption) 157 | end 158 | ; 159 | 160 | {if c is TColorPickerButton then with c as TColorPickerButton do 161 | begin 162 | caption:=trans(caption); 163 | customText:=trans(customText); 164 | end;} 165 | 166 | for i:=c.componentCount-1 downto 0 do 167 | translateComponent(c.components[i], window); 168 | end; // translateComponent 169 | 170 | procedure translateWindow(w: Tform); 171 | begin translateComponent(w, w) end; 172 | 173 | procedure translateWindows; 174 | var 175 | i: integer; 176 | begin 177 | i := 0; 178 | while i < screen.formCount do 179 | begin 180 | translateWindow(screen.forms[i]); 181 | inc(i); 182 | end; 183 | 184 | i := 0; 185 | while i < screen.DataModuleCount do 186 | begin 187 | translateComponent(screen.DataModules[i], NIL); 188 | inc(i); 189 | end; 190 | end; // translateWindows 191 | 192 | end. 193 | -------------------------------------------------------------------------------- /lib/RegExpr.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/drapid/HFS/06a40abe58c47b63bbe60fd63767d33c123d8d44/lib/RegExpr.pas -------------------------------------------------------------------------------- /lib/diffDlg.dfm: -------------------------------------------------------------------------------- 1 | object diffFrm: TdiffFrm 2 | Left = 261 3 | Top = 149 4 | Caption = 'Customized options' 5 | ClientHeight = 334 6 | ClientWidth = 432 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -11 11 | Font.Name = 'MS Sans Serif' 12 | Font.Style = [] 13 | OldCreateOrder = False 14 | Position = poMainFormCenter 15 | PixelsPerInch = 96 16 | TextHeight = 13 17 | object memoBox: TMemo 18 | Left = 0 19 | Top = 0 20 | Width = 432 21 | Height = 334 22 | Align = alClient 23 | ReadOnly = True 24 | ScrollBars = ssBoth 25 | TabOrder = 0 26 | end 27 | end 28 | -------------------------------------------------------------------------------- /lib/diffDlg.pas: -------------------------------------------------------------------------------- 1 | unit diffDlg; 2 | 3 | interface 4 | 5 | uses 6 | Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 7 | Dialogs, StdCtrls; 8 | 9 | type 10 | TdiffFrm = class(TForm) 11 | memoBox: TMemo; 12 | private 13 | { Private declarations } 14 | public 15 | { Public declarations } 16 | end; 17 | 18 | var 19 | diffFrm: TdiffFrm; 20 | 21 | implementation 22 | 23 | {$R *.dfm} 24 | 25 | end. 26 | -------------------------------------------------------------------------------- /lib/folderKindDlg.dfm: -------------------------------------------------------------------------------- 1 | object folderKindFrm: TfolderKindFrm 2 | Left = 257 3 | Top = 199 4 | BorderIcons = [biSystemMenu, biMinimize] 5 | BorderStyle = bsDialog 6 | Caption = 'What kind of folder do you want?' 7 | ClientHeight = 206 8 | ClientWidth = 367 9 | Color = clBtnFace 10 | Font.Charset = DEFAULT_CHARSET 11 | Font.Color = clWindowText 12 | Font.Height = -11 13 | Font.Name = 'MS Sans Serif' 14 | Font.Style = [] 15 | OldCreateOrder = False 16 | Position = poMainFormCenter 17 | OnCreate = FormCreate 18 | PixelsPerInch = 96 19 | TextHeight = 13 20 | object realLbl: TLabel 21 | Left = 136 22 | Top = 40 23 | Width = 191 24 | Height = 13 25 | Caption = 'A real folder is faster, good for big folders' 26 | end 27 | object virtuaLbl: TLabel 28 | Left = 136 29 | Top = 96 30 | Width = 213 31 | Height = 13 32 | Caption = 'A virtual folder is easier, good for small folders' 33 | WordWrap = True 34 | end 35 | object Label3: TLabel 36 | Left = 48 37 | Top = 128 38 | Width = 28 39 | Height = 63 40 | Caption = '?' 41 | Font.Charset = ANSI_CHARSET 42 | Font.Color = clWindowText 43 | Font.Height = -56 44 | Font.Name = 'Times New Roman' 45 | Font.Style = [fsBold] 46 | ParentFont = False 47 | end 48 | object hintLbl: TLabel 49 | Left = 80 50 | Top = 152 51 | Width = 201 52 | Height = 33 53 | AutoSize = False 54 | Caption = 'Not sure? Hint: most time you need real folders!' 55 | end 56 | object realBtn: TBitBtn 57 | Left = 20 58 | Top = 34 59 | Width = 107 60 | Height = 25 61 | Caption = '&Real folder' 62 | Default = True 63 | ModalResult = 7 64 | TabOrder = 0 65 | Glyph.Data = { 66 | 36040000424D3604000000000000360000002800000010000000100000000100 67 | 2000000000000004000000000000000000000000000000000000FF00FF00FF00 68 | FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00 69 | FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00 70 | FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00 71 | FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00 72 | FF006D6DED001B1BC9001B1BC9003838E6007676EE00B2B2F600FF00FF00FF00 73 | FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00 74 | FF006161EB008383EF006565EB004343E7001E1EDE001919BD001A1AC0002828 75 | E4006565EB00A4A4F400FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00 76 | FF004848E8009494F2008686F0008686F0008686F0008686F0007C7CEE005A5A 77 | EA002C2CE4001B1BCD001919BB009393F100FF00FF00FF00FF00FF00FF00FF00 78 | FF002727E3009A9AF2008D8DF1008D8DF1008D8DF1008D8DF1008D8DF1008D8D 79 | F1008D8DF1008D8DF1003838E6005353E900FF00FF00FF00FF00FF00FF00FF00 80 | FF003131E500B1B1F5009696F2009696F2009696F2009696F2009696F2009696 81 | F2009696F2009696F2005E5EEA003535E500FF00FF00FF00FF00FF00FF00FF00 82 | FF002727E300B1B1F5009F9FF3009F9FF3009F9FF3009F9FF3009F9FF3009F9F 83 | F3009F9FF3009F9FF3007878EE001D1DDB00FF00FF00FF00FF00FF00FF00FF00 84 | FF004848E800A4A4F400A4A4F400A4A4F400A4A4F400A4A4F400A4A4F400A4A4 85 | F400A4A4F400A4A4F4009494F2001A1AC600FF00FF00FF00FF00FF00FF00FF00 86 | FF005E5EEA00AFAFF500C6C6F800C1C1F700BBBBF700BBBBF700BBBBF700BBBB 87 | F700BBBBF700BBBBF700ABABF5001B1BCB00FF00FF00FF00FF00FF00FF00D9D9 88 | FB008F8FF1006161EB006D6DED006F6FED009191F100D9D9FB00D1D1F900D2D2 89 | FA00D1D1F900D2D2FA00BBBBF7001E1EE200B4B4F600FF00FF00FF00FF00D9D9 90 | FB00B1B1F500A4A4F400A4A4F400A4A4F4008686F0006C6CEC009898F200BABA 91 | F600DDDDFB00EDEDFD00CFCFF9003C3CE6009F9FF300FF00FF00FF00FF00FF00 92 | FF00A1A1F300A4A4F400A4A4F400A4A4F400B2B2F6009191F1009494F2009494 93 | F2008686F0007171ED005151E9006161EB00FF00FF00FF00FF00FF00FF00FF00 94 | FF00A8A8F4009B9BF300A4A4F400B6B6F6007F7FEF00E4E4FC00FF00FF00CDCD 95 | F900AAAAF400ABABF500B4B4F600FF00FF00FF00FF00FF00FF00FF00FF00FF00 96 | FF00FF00FF00FF00FF00FF00FF00D9D9FB00FF00FF00FF00FF00FF00FF00FF00 97 | FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00 98 | FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00 99 | FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00} 100 | end 101 | object virtuaBtn: TBitBtn 102 | Left = 20 103 | Top = 90 104 | Width = 107 105 | Height = 25 106 | Caption = '&Virtual folder' 107 | ModalResult = 6 108 | TabOrder = 1 109 | Glyph.Data = { 110 | 36040000424D3604000000000000360000002800000010000000100000000100 111 | 2000000000000004000000000000000000000000000000000000FF00FF00FF00 112 | FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00 113 | FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00 114 | FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00 115 | FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00 116 | FF0086BED40049869B005A7E89008D8F9100B1B2B100D6D1D100FF00FF00FF00 117 | FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00 118 | FF006AC3E20075DCFD005BCAF40043BCE70035A1C7003587A0004C7C8E008089 119 | 8C00A8A8A800CCCCCB00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00 120 | FF0052B9DD0087E1FE0078DEFD0078DEFD0078DEFD0078DEFD006FD8FB0056C8 121 | EE0043A9CD003C8FAB0049798A00C1C2C100FF00FF00FF00FF00FF00FF00FF00 122 | FF0031ADD9008DE6FE0080E6FE0080E6FE0080E6FE0080E6FE0080E6FE0080E6 123 | FE0080E6FE0080E6FE003FB7DE009D9E9E00FF00FF00FF00FF00FF00FF00FF00 124 | FF003CB1D900A8F2FE0088EFFF0088EFFF0088EFFF0088EFFF0088EFFF0088EF 125 | FF0088EFFF0088EFFF0059CBEF0087919300FF00FF00FF00FF00FF00FF00FF00 126 | FF0031ADD900A7F8FE0093F8FF0093F8FF0093F8FF0093F8FF0093F8FF0093F8 127 | FF0093F8FF0093F8FF006ED8F80067859000FF00FF00FF00FF00FF00FF00FF00 128 | FF004CBAE300A2EDF60099FDFF0099FDFF0099FDFF0099FDFF0099FDFF0099FD 129 | FF0099FDFF0099FDFF0088E8FE004E7F9100FF00FF00FF00FF00FF00FF00FF00 130 | FF0065C1E200B0E8F400C0FCFE00B9FCFE00B3FDFF00B3FDFF00B3FDFF00B3FD 131 | FF00B3FDFF00B3FDFF00A1F3FF004A859B00FF00FF00FF00FF00FF00FF00DBEF 132 | F8008CE0F3005ED4ED006CCFED0074CDE80093D9EE00D6FBFD00CBFCFE00CDFB 133 | FE00CBFCFE00CDFBFE00B3F1FE005A93A600D4D4D500FF00FF00FF00FF00DBEF 134 | F800AFEDF60099FDFF0099FDFF0099FDFF0080ECF60072CBE5009CDBEE00BBEA 135 | F500DDF6FB00ECFDFE00CAF3FD0061A5C000C9C9C800FF00FF00FF00FF00FF00 136 | FF00A5DDEF0099FDFF0099FDFF0099FDFF00AFF1F90099D9E90093DFF20094DB 137 | F20089D8ED0074D4EA0062B9D8007ABAD200FF00FF00FF00FF00FF00FF00FF00 138 | FF00ADDDEF00A0DBED00A6E3F200B5ECF60098C3D500F0F0F000FF00FF00D0EB 139 | F600AFDEEE00B0DFF000BEE0EC00FF00FF00FF00FF00FF00FF00FF00FF00FF00 140 | FF00FF00FF00FF00FF00FF00FF00DBEFF800FF00FF00FF00FF00FF00FF00FF00 141 | FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00 142 | FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00 143 | FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00} 144 | end 145 | end 146 | -------------------------------------------------------------------------------- /lib/folderKindDlg.pas: -------------------------------------------------------------------------------- 1 | unit folderKindDlg; 2 | 3 | interface 4 | 5 | uses 6 | Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 7 | Dialogs, StdCtrls, Buttons, strUtils, ExtCtrls; 8 | 9 | type 10 | TfolderKindFrm = class(TForm) 11 | realLbl: TLabel; 12 | virtuaLbl: TLabel; 13 | realBtn: TBitBtn; 14 | virtuaBtn: TBitBtn; 15 | Label3: TLabel; 16 | hintLbl: TLabel; 17 | procedure FormCreate(Sender: TObject); 18 | private 19 | { Private declarations } 20 | public 21 | { Public declarations } 22 | end; 23 | 24 | implementation 25 | 26 | {$R *.dfm} 27 | 28 | procedure TfolderKindFrm.FormCreate(Sender: TObject); 29 | begin 30 | realBtn.Font.Style:=[fsBold]; 31 | with hintLbl do caption:=ansiReplaceStr(caption,'? ','?'#13); 32 | end; 33 | 34 | end. 35 | -------------------------------------------------------------------------------- /lib/longinputDlg.dfm: -------------------------------------------------------------------------------- 1 | object longinputFrm: TlonginputFrm 2 | Left = 191 3 | Top = 187 4 | BorderStyle = bsSizeToolWin 5 | Caption = 'longinputFrm' 6 | ClientHeight = 314 7 | ClientWidth = 465 8 | Color = clBtnFace 9 | Font.Charset = DEFAULT_CHARSET 10 | Font.Color = clWindowText 11 | Font.Height = -11 12 | Font.Name = 'MS Sans Serif' 13 | Font.Style = [] 14 | OldCreateOrder = False 15 | Position = poMainFormCenter 16 | PixelsPerInch = 96 17 | TextHeight = 13 18 | object bottomPnl: TPanel 19 | Left = 0 20 | Top = 282 21 | Width = 465 22 | Height = 32 23 | Align = alBottom 24 | BevelOuter = bvNone 25 | TabOrder = 1 26 | OnResize = bottomPnlResize 27 | object okBtn: TButton 28 | Left = 55 29 | Top = 4 30 | Width = 75 31 | Height = 25 32 | Caption = '&OK' 33 | Default = True 34 | ModalResult = 1 35 | TabOrder = 0 36 | end 37 | object cancelBtn: TButton 38 | Left = 135 39 | Top = 4 40 | Width = 75 41 | Height = 25 42 | Caption = '&Cancel' 43 | ModalResult = 2 44 | TabOrder = 1 45 | end 46 | end 47 | object topPnl: TPanel 48 | Left = 0 49 | Top = 0 50 | Width = 465 51 | Height = 41 52 | Align = alTop 53 | BevelOuter = bvNone 54 | TabOrder = 2 55 | object msgLbl: TLabel 56 | Left = 0 57 | Top = 0 58 | Width = 17 59 | Height = 13 60 | Align = alClient 61 | Caption = 'test' 62 | Layout = tlCenter 63 | WordWrap = True 64 | end 65 | end 66 | object inputBox: TMemo 67 | Left = 0 68 | Top = 41 69 | Width = 465 70 | Height = 241 71 | Align = alClient 72 | Lines.Strings = ( 73 | 'Memo1') 74 | ScrollBars = ssVertical 75 | TabOrder = 0 76 | OnKeyDown = inputBoxKeyDown 77 | end 78 | end 79 | -------------------------------------------------------------------------------- /lib/longinputDlg.pas: -------------------------------------------------------------------------------- 1 | unit longinputDlg; 2 | 3 | interface 4 | 5 | uses 6 | Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 7 | Dialogs, StdCtrls, ExtCtrls; 8 | 9 | type 10 | TlonginputFrm = class(TForm) 11 | bottomPnl: TPanel; 12 | okBtn: TButton; 13 | cancelBtn: TButton; 14 | topPnl: TPanel; 15 | msgLbl: TLabel; 16 | inputBox: TMemo; 17 | procedure bottomPnlResize(Sender: TObject); 18 | procedure inputBoxKeyDown(Sender: TObject; var Key: Word; 19 | Shift: TShiftState); 20 | private 21 | { Private declarations } 22 | public 23 | { Public declarations } 24 | end; 25 | 26 | implementation 27 | 28 | {$R *.dfm} 29 | 30 | procedure TlonginputFrm.bottomPnlResize(Sender: TObject); 31 | begin 32 | okBtn.left := (bottomPnl.Width-cancelBtn.BoundsRect.right+okBtn.BoundsRect.left) div 2; 33 | cancelBtn.left := okBtn.BoundsRect.Right+10; 34 | end; 35 | 36 | procedure TlonginputFrm.inputBoxKeyDown(Sender: TObject; var Key: Word; 37 | Shift: TShiftState); 38 | begin 39 | if shift = [ssCtrl] then 40 | if key = ord('A') then 41 | inputBox.SelectAll(); 42 | end; 43 | 44 | end. 45 | -------------------------------------------------------------------------------- /lib/monoLib.pas: -------------------------------------------------------------------------------- 1 | { 2 | Copyright (C) 2002-2008 Massimo Melina (www.rejetto.com) 3 | 4 | This program is free software; you can redistribute it and/or modify 5 | it under the terms of the GNU General Public License as published by 6 | the Free Software Foundation; either version 2 of the License, or 7 | (at your option) any later version. 8 | 9 | This program is distributed in the hope that it will be useful, 10 | but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | GNU General Public License for more details. 13 | 14 | You should have received a copy of the GNU General Public License 15 | along with this program; if not, write to the Free Software 16 | Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 17 | 18 | 19 | This lib ensures only one instance of the software does run 20 | } 21 | unit monoLib; 22 | 23 | interface 24 | 25 | uses 26 | windows, messages, forms, classes, sysUtils; 27 | 28 | type 29 | Tmono = class 30 | private 31 | msgID: Thandle; 32 | Fmaster: boolean; 33 | Ferror: string; 34 | Fworking: boolean; 35 | function hook(var msg: TMessage): Boolean; 36 | public 37 | onSlaveParams: procedure(const params: String); 38 | property error: String read Ferror; 39 | property master: Boolean read Fmaster; 40 | property working: Boolean read Fworking; 41 | 42 | function init(id: String): Boolean; // FALSE on error 43 | procedure sendParams(); 44 | end; 45 | 46 | var 47 | mono: Tmono; 48 | initialPath: string; 49 | 50 | implementation 51 | 52 | const 53 | //MSG_WHEREAREYOU = 1; 54 | //MSG_HEREIAM = 2; 55 | MSG_PARAMS = 3; 56 | 57 | function atomToStr(atom:Tatom):string; 58 | begin 59 | setlength(result, 5000); 60 | setlength(result, globalGetAtomName(atom, @result[1], length(result))); 61 | end; // atomToStr 62 | 63 | function Tmono.hook(var msg: TMessage): Boolean; 64 | begin 65 | result := master and (msg.msg = msgID) and (msg.wparam = MSG_PARAMS); 66 | if not result or not assigned(onSlaveParams) then 67 | exit; 68 | msg.Result := 1; 69 | onSlaveParams(atomToStr(msg.lparam)); 70 | GlobalDeleteAtom(msg.LParam); 71 | end; // hook 72 | 73 | function Tmono.init(id: String): Boolean; 74 | begin 75 | result := FALSE; 76 | msgID := RegisterWindowMessage(pchar(id)); 77 | {$IFNDEF FPC} 78 | application.HookMainWindow(hook); 79 | {$ENDIF ~FPC} 80 | // the mutex is auto-released when the application terminates 81 | if CreateMutex(nil, True, pchar(id)) = 0 then 82 | begin 83 | setlength(Ferror,1000); 84 | setlength(Ferror, FormatMessage( 85 | FORMAT_MESSAGE_FROM_SYSTEM+FORMAT_MESSAGE_IGNORE_INSERTS, NIL, 86 | GetLastError(), 0, @Ferror[1], length(Ferror), NIL) ); 87 | exit; 88 | end; 89 | Fmaster := GetLastError() <> ERROR_ALREADY_EXISTS; 90 | Fworking := TRUE; 91 | result := TRUE; 92 | end; // init 93 | 94 | procedure Tmono.sendParams(); 95 | var 96 | s: string; 97 | i: integer; 98 | begin 99 | s:=initialPath+#13+paramStr(0); 100 | for i:=1 to paramCount() do 101 | s:=s+#13+paramStr(i); 102 | // the master will delete the atom 103 | postMessage(HWND_BROADCAST, msgId, MSG_PARAMS, GlobalAddAtom(pchar(s))); 104 | end; // sendParams 105 | 106 | initialization 107 | initialPath:=getCurrentDir(); 108 | mono:=Tmono.create; 109 | 110 | finalization 111 | mono.free; 112 | 113 | end. 114 | -------------------------------------------------------------------------------- /lib/progFrmLib.pas: -------------------------------------------------------------------------------- 1 | { 2 | Copyright (C) 2002-2008 Massimo Melina (www.rejetto.com) 3 | 4 | This program is free software; you can redistribute it and/or modify 5 | it under the terms of the GNU General Public License as published by 6 | the Free Software Foundation; either version 2 of the License, or 7 | (at your option) any later version. 8 | 9 | This program is distributed in the hope that it will be useful, 10 | but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | GNU General Public License for more details. 13 | 14 | You should have received a copy of the GNU General Public License 15 | along with this program; if not, write to the Free Software 16 | Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 17 | 18 | 19 | } 20 | unit progFrmLib; 21 | 22 | interface 23 | 24 | uses 25 | ComCtrls, Forms, controls, ExtCtrls, buttons, graphics; 26 | 27 | type 28 | TprogressForm = class 29 | private 30 | prog: TProgressBar; 31 | frm: Tform; 32 | msgPnl: Tpanel; 33 | cancelBtn: TbitBtn; 34 | btnPnl: Tpanel; 35 | stack: array of record ofs,length: real end; 36 | partialLength: real; 37 | canceled: boolean; 38 | function getPos(): real; 39 | procedure setPos(x: real); 40 | function getGlobalPos(): real; 41 | procedure setGlobalPos(x: real); 42 | function getCaption():string; 43 | procedure setCaption(const x: String); 44 | function getVisible(): boolean; 45 | procedure onCancel(Sender: TObject); 46 | procedure onResize(Sender: TObject); 47 | procedure setSize; 48 | public 49 | preventBackward: boolean; 50 | constructor create; 51 | procedure show(const caption_: String=''; cancel:boolean=FALSE); 52 | procedure hide(); 53 | property progress:real read getPos write setPos; 54 | property globalPosition:real read getGlobalPos write setGlobalPos; 55 | property caption:string read getCaption write setCaption; 56 | property visible:boolean read getVisible; 57 | property cancelRequested:boolean read canceled; 58 | procedure push(sublength:real); 59 | procedure pop(); 60 | procedure showCancel(); 61 | procedure hideCancel(); 62 | procedure reset(); 63 | end; 64 | 65 | implementation 66 | 67 | function max(a,b:integer):integer; 68 | begin if a > b then result:=a else result:=b end; 69 | 70 | constructor TprogressForm.create; 71 | var 72 | coef: Real; 73 | begin 74 | frm:=Tform.create(Application.MainForm); 75 | frm.Position:=poScreenCenter; 76 | {$IFDEF FPC} 77 | if frm.PixelsPerInch = 96 then 78 | coef := 1 79 | else 80 | coef := frm.PixelsPerInch / 96; 81 | {$ELSE ~FPC} 82 | { 83 | if frm.currentPPI = 96 then 84 | coef := 1 85 | else 86 | coef := frm.currentPPI / 96; 87 | } 88 | coef := frm.ScaleFactor; 89 | {$ENDIF FPC} 90 | 91 | frm.Width := trunc(coef * 220); 92 | frm.BorderStyle:=bsNone; 93 | frm.BorderWidth:= trunc(coef * 15); 94 | frm.Height:= trunc(25 * coef)+frm.BorderWidth*2; 95 | frm.OnResize:=onResize; 96 | //frm.FormStyle:=fsStayOnTop; 97 | 98 | msgPnl:=Tpanel.create(frm); 99 | msgPnl.Parent:=frm; 100 | msgPnl.align:=alTop; 101 | msgPnl.height:= trunc(coef * 20); 102 | msgPnl.BevelOuter:=bvLowered; 103 | 104 | prog:=TProgressBar.Create(frm); 105 | prog.Parent:=frm; 106 | prog.BorderWidth:=trunc(coef * 3); 107 | prog.Min:=0; 108 | prog.max:=100; // resolution 109 | prog.Align:=alClient; 110 | prog.smooth:=TRUE; 111 | 112 | btnPnl:=Tpanel.create(frm); 113 | btnPnl.parent:=frm; 114 | btnPnl.Align:=alBottom; 115 | btnPnl.BevelOuter:=bvLowered; 116 | 117 | cancelBtn:=TbitBtn.create(frm); 118 | cancelBtn.parent:=btnPnl; 119 | cancelBtn.Kind:=bkCancel; 120 | cancelBtn.top := trunc(coef * 10); 121 | cancelBtn.OnClick:=onCancel; 122 | 123 | btnPnl.Height := cancelBtn.Height+cancelBtn.top*2; 124 | btnPnl.Hide(); 125 | 126 | partialLength:=1; 127 | push(1); // init stack 128 | frm.Height:=frm.Height+msgPnl.Height; 129 | end; // constructor 130 | 131 | function TprogressForm.getVisible():boolean; 132 | begin result := frm.Visible end; 133 | 134 | procedure TprogressForm.showCancel(); 135 | begin 136 | if btnPnl.visible then 137 | exit; 138 | frm.Height := frm.Height+btnPnl.Height; 139 | btnPnl.show(); 140 | end; // showCancel 141 | 142 | procedure TprogressForm.hideCancel(); 143 | begin 144 | if not btnPnl.visible then exit; 145 | frm.Height:=frm.Height-btnPnl.Height; 146 | btnPnl.hide(); 147 | end; // hideCancel 148 | 149 | procedure TprogressForm.show(const caption_: String; cancel:boolean); 150 | begin 151 | canceled := FALSE; 152 | if not frm.visible then 153 | reset(); 154 | if caption_ > '' then 155 | caption := caption_; 156 | if cancel then 157 | showCancel(); 158 | setSize; 159 | frm.Show(); 160 | end; // show 161 | 162 | procedure TprogressForm.hide(); 163 | begin 164 | frm.hide(); 165 | hideCancel(); 166 | end; 167 | 168 | function TprogressForm.getCaption(): String; 169 | begin result := msgPnl.caption end; 170 | 171 | procedure TprogressForm.setCaption(const x: String); 172 | var 173 | coef: Real; 174 | begin 175 | {$IFDEF FPC} 176 | if frm.PixelsPerInch = 96 then 177 | coef := 1 178 | else 179 | coef := frm.PixelsPerInch / 96; 180 | {$ELSE ~FPC} 181 | { 182 | if frm.currentPPI = 96 then 183 | coef := 1 184 | else 185 | coef := frm.currentPPI / 96; 186 | } 187 | coef := frm.ScaleFactor; 188 | {$ENDIF FPC} 189 | msgPnl.caption := x; 190 | frm.Width:=max(trunc(200 * coef), 191 | frm.Canvas.TextWidth(x)+(msgPnl.BorderWidth+frm.BorderWidth)*2+trunc(coef * 20) ); 192 | end; 193 | 194 | procedure TprogressForm.setGlobalPos(x:real); 195 | begin 196 | x:=x*prog.max; 197 | if preventBackward and (prog.position > x) then x:=prog.position; 198 | prog.position:=round(x); 199 | end; // setGlobalPos 200 | 201 | function TprogressForm.getGlobalPos():real; 202 | begin result:=prog.position/prog.max end; 203 | 204 | procedure TprogressForm.setPos(x:real); 205 | begin setGlobalPos(stack[length(stack)-1].ofs + x*partialLength ) end; 206 | 207 | function TprogressForm.getPos():real; 208 | begin result:=getGlobalPos()/partialLength + stack[length(stack)-1].ofs end; 209 | 210 | procedure TprogressForm.push(sublength:real); 211 | var 212 | i: integer; 213 | begin 214 | assert(sublength <= 1,'TprogressForm.push(X): X>1'); 215 | i:=length(stack); 216 | setLength(stack, i+1); 217 | stack[i].ofs:=globalPosition; 218 | stack[i].length:=partialLength; 219 | partialLength:=partialLength*sublength; 220 | end; // push 221 | 222 | procedure TprogressForm.pop(); 223 | var 224 | i: integer; 225 | begin 226 | assert(length(stack) > 1, 'TprogressForm.pop(): empty stack'); 227 | progress:=1; 228 | i:=length(stack)-1; 229 | partialLength:=stack[i].length; 230 | setlength(stack, i); 231 | end; // pop 232 | 233 | procedure TprogressForm.onCancel(Sender: TObject); 234 | begin canceled:=TRUE end; 235 | 236 | procedure TprogressForm.onResize(Sender: TObject); 237 | begin cancelBtn.left:=(frm.width-cancelBtn.width) div 2-frm.borderWidth end; 238 | 239 | procedure TprogressForm.setSize; 240 | var 241 | coef: Real; 242 | begin 243 | {$IFDEF FPC} 244 | if frm.PixelsPerInch = 96 then 245 | coef := 1 246 | else 247 | coef := frm.PixelsPerInch / 96; 248 | {$ELSE ~FPC} 249 | { 250 | if frm.currentPPI = 96 then 251 | coef := 1 252 | else 253 | coef := frm.currentPPI / 96; 254 | } 255 | coef := frm.ScaleFactor; 256 | {$ENDIF FPC} 257 | 258 | frm.DisableAlign; 259 | try 260 | 261 | frm.Width := trunc(coef * 220); 262 | frm.BorderWidth:= trunc(coef * 15); 263 | frm.Height:= trunc(25 * coef)+frm.BorderWidth*2; 264 | 265 | msgPnl.height:= trunc(coef * 20); 266 | 267 | prog.BorderWidth := trunc(coef * 3); 268 | 269 | cancelBtn.top := trunc(coef * 10); 270 | 271 | {$IFDEF FPC} 272 | cancelBtn.ScaleBy(frm.PixelsPerInch, 96); 273 | {$ELSE ~FPC} 274 | cancelBtn.ScaleForPPI(frm.currentPPI); 275 | {$ENDIF FPC} 276 | 277 | btnPnl.Height:=cancelBtn.Height+cancelBtn.top*2; 278 | 279 | frm.Height := frm.Height+msgPnl.Height; 280 | if btnPnl.Visible then 281 | frm.Height := frm.Height + btnPnl.Height; 282 | finally 283 | frm.EnableAlign; 284 | end; 285 | 286 | end; 287 | 288 | procedure TprogressForm.reset(); 289 | begin prog.position:=0 end; 290 | 291 | end. 292 | -------------------------------------------------------------------------------- /lib/purgeDlg.dfm: -------------------------------------------------------------------------------- 1 | object purgeFrm: TpurgeFrm 2 | Left = 0 3 | Top = 0 4 | Caption = 'Purge options' 5 | ClientHeight = 152 6 | ClientWidth = 186 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -11 11 | Font.Name = 'Tahoma' 12 | Font.Style = [] 13 | OldCreateOrder = False 14 | Position = poMainFormCenter 15 | PixelsPerInch = 96 16 | TextHeight = 13 17 | object Label1: TLabel 18 | Left = 8 19 | Top = 8 20 | Width = 127 21 | Height = 13 22 | Caption = 'Choose what to remove...' 23 | end 24 | object rmFilesChk: TCheckBox 25 | Left = 8 26 | Top = 35 27 | Width = 177 28 | Height = 17 29 | Caption = 'Non-existent files' 30 | Checked = True 31 | State = cbChecked 32 | TabOrder = 0 33 | end 34 | object rmRealFoldersChk: TCheckBox 35 | Left = 8 36 | Top = 58 37 | Width = 171 38 | Height = 17 39 | Caption = 'Non-existent real folders' 40 | Checked = True 41 | State = cbChecked 42 | TabOrder = 1 43 | end 44 | object rmEmptyFoldersChk: TCheckBox 45 | Left = 8 46 | Top = 81 47 | Width = 177 48 | Height = 17 49 | Caption = 'Empty folders' 50 | Checked = True 51 | State = cbChecked 52 | TabOrder = 2 53 | end 54 | object Button1: TButton 55 | Left = 8 56 | Top = 118 57 | Width = 75 58 | Height = 25 59 | Caption = '&Ok' 60 | Default = True 61 | ModalResult = 1 62 | TabOrder = 3 63 | end 64 | object Button2: TButton 65 | Left = 103 66 | Top = 118 67 | Width = 75 68 | Height = 25 69 | Caption = '&Cancel' 70 | ModalResult = 2 71 | TabOrder = 4 72 | end 73 | end 74 | -------------------------------------------------------------------------------- /lib/purgeDlg.pas: -------------------------------------------------------------------------------- 1 | unit purgeDlg; 2 | 3 | interface 4 | 5 | uses 6 | Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 7 | Dialogs, StdCtrls; 8 | 9 | type 10 | TpurgeFrm = class(TForm) 11 | rmFilesChk: TCheckBox; 12 | Label1: TLabel; 13 | rmRealFoldersChk: TCheckBox; 14 | rmEmptyFoldersChk: TCheckBox; 15 | Button1: TButton; 16 | Button2: TButton; 17 | private 18 | { Private declarations } 19 | public 20 | { Public declarations } 21 | end; 22 | 23 | //var 24 | // purgeFrm: TpurgeFrm; 25 | 26 | implementation 27 | 28 | {$R *.dfm} 29 | 30 | 31 | end. 32 | -------------------------------------------------------------------------------- /lib/shellExtDlg.dfm: -------------------------------------------------------------------------------- 1 | object shellExtFrm: TshellExtFrm 2 | Left = 226 3 | Top = 146 4 | Caption = 'Option...' 5 | ClientHeight = 265 6 | ClientWidth = 388 7 | Color = clBtnFace 8 | ParentFont = True 9 | OldCreateOrder = False 10 | Position = poDesktopCenter 11 | PixelsPerInch = 96 12 | TextHeight = 13 13 | object Image1: TImage 14 | Left = 0 15 | Top = 0 16 | Width = 388 17 | Height = 169 18 | Align = alTop 19 | Picture.Data = { 20 | 0954506E67496D61676589504E470D0A1A0A0000000D49484452000001830000 21 | 00A904030000003B0A4CC5000000017352474200AECE1CE90000000467414D41 22 | 0000B18F0BFC610500000030504C544500000000336633336666000066666633 23 | 33990066CC6699CCCC993399999999CCFFCCCC99FFCC99CCCCCCFFFFFF000000 24 | 2BF950F1000000097048597300000EC300000EC301C76FA864000014D6494441 25 | 5478DADD9D0D5413D7B6C74F02A2583F8262B11594D2673105C44A814B25314A 26 | 58EA02BC146FE529D8F254A4ABAD84A6BDAFAF5559A9A26DBDBD948BD65B4AF5 27 | 6945AB824869587EA1B2A86D2D8A06480845F0A9CBD627A0C40FE00964F2F699 28 | 09C9840C61204C907B96C699CCCC99F33B7B9F99FD9F7D26F2EEA1115E1EF0AC 29 | 100CBCE16E94BD08777647FAF07982E16E983D085F54C18761DF70376CB0085D 30 | A3106A758385A2D8E16ED820110C0712C10AEF0E130221D5DE26E4995EBEAA42 31 | 09B5AE9A2679B8D7B8B5D5ED37DFF68AE0792A9B08065D09464849FA5AF086D1 32 | 9188D57B91A30A513EEF2771B6B4A938539E45AE67A721A26731F54FDB432A3C 33 | 84EA4FF36C22B4A2921E2BBCB18F0875D95AAD2828963DD70A63BBF614FFE3FC 34 | F472F17205D543DC94F60AB1EC4AB93C73B3A207E1D88D48119C91906FCF7279 35 | 6BD712DF1C94620BC1A0131CA0ACE0BA0F10C4E5B3D584A2F54ACEE9316FE2DE 36 | 20363F93BC594150D57353B44222E473B194EE48FCCA72300421DF76417E79B3 37 | E7DAC40F026C235858419EB9F433D1B4A73781F55A24843C5934FD90CFCF5344 38 | D355AC5B34D0422C5512A2B6CBF21E47826E93218DEA59352CA6F82E2D5EE0F5 39 | AD3CB9596203A115A1129A15E49931F7CB65FAA7E349046CE06D55A1E272AA7A 40 | 4E8AA619BA6AD63A79A6F8BC19C1298B5CF4518CBE9DABD93E15A5A7B1403059 41 | 2130627B508430FCF49875E27299130CA7370EC8B787706605025A4EC8B7E6DC 42 | CC9CAB3221F01B957871AEA7B226A0FA5EF045F15CABF33359A1538011A45547 43 | AB33E29D924F2A9BAAA1F37D325642EF6467ACE4CC0A9DD0C5A9F2CCC5DD5547 44 | 252604277060954654509CA569766FF11082B3B1B2426BA9F3AB8485C71073B9 45 | 1B02F6961E0483CECD886028C81F151B29B04020A4E992E16E290B0481AE0741 46 | 8A90DB70B76B1008ADE427461871C50AA1AB082FBC36DCEDB20BE111FCDBFDD7 47 | BDC3DD307B1020DE465D5D6387BB617623248CDD3BDC2DB30301E1C1F0FE020A 48 | 81E0309E6053D89CDF7C513521043E46482FB144E0168590D6FE21D5FE2E6D52 49 | 5B491E32445AA842E97C457AB16AEC2D7608B390C311CA432EF0A75C7F6A7200 50 | 215F6B963C64944D2E6A859D21AAA258E6188101010683E139C99ED046202F28 51 | 5EDD92D1A4466D5E1B9555D501A36F730401C170FBBD06F7160BC9638C91C026 52 | 5AA10607D91AEB489B19C1B0FCD06840E82579924F2F12721629B585AA9176C2 53 | D5900A31B3E4D10AB542F8262785E9600684CE04A1CB3EC99E5E9227056A8105 54 | 8EACA069162F2D86D858CC2C7930C2C27B97997B90C99162F787DFC70874C923 55 | 5F13A0152E39CE1101EAFC794A33F6973E240F7624319362EB0301DF9E5FC208 56 | 74C923CE69F6787E9B8233803BE9D0EC25C7FB903C78385F960B19FD8801A1C3 57 | 1B162648F658489EF3D9DD19BCE218B0291785701F7B6D2ADA98919E46304A1E 58 | 4040D98A8D4A15E3F9AD114691EB497BAC2EA375B3B8B181BDC5A4DA5A7B101E 59 | 91ABEFF646E89CCA9109861EA13D895C1D8131920961E4957F4984AF914BD270 60 | B76A7008E42509103A9D8BFC5F18EE56D987B07BB647732542EB86BB617620EC 61 | 4DE898805063C475FC25AB589B0C8A654E1C6B23AD2E8C35C2BCD1DDB0D61B21 62 | C5D792828C1C9910A80D34E67EA40679B4B4A91AAB1E55A1982679E0A6EDF2BF 63 | A61A0682305F728E094168BB11BD10D897EC3D2A8891EAD681EA49C78F85CD92 64 | 07ED0878E567C96010E6AAC231C235903C91A2E9AB3FBE0B718B8C5FA38EBF70 65 | 4BB894AF2894A853B5674B5FD6A747ECBC311594A04634FD80A8E09853B2F8A8 66 | A473AAD7646DA938BFE0C78864D14625A9959CE32F345A3F51B7E800758B8710 67 | A99B30024DF2A0C43C8809C69E2E8D0BD8A8AC3FAD0BA2CE5690D1742835E29F 68 | 2752EB4F97AEB74020AFAAA41554812482B83CD0B34476E554051857E694E22B 69 | BBB2AB45AE22362BD42D931F5C5C74B7F3F5E30110371151B053B90CA186EFB7 70 | C1A66F36F8467D9F71B1E4DDFAE31AAC95101128B902E2A91F04F796E0D06A9C 71 | 2EA44B1E32E6AED34398BDB6C54387C2709416ADD434D78537BD7EFC7EF7E407 72 | 5D1266841E2B805E989929ABDD24218C08F017E77A5410BC57AFD0EA42617C48 73 | AB481B69405E212708F335F16AADAF3C737E101C9145492475D331A74CEB27EA 74 | 5608125095200A2C250F8C922A65184E31F19428943C1BAEF6219C5B1706ADB8 75 | EE6DD30A24823C337293D88C80CD9C6546B8DBED212401496D82958A263EBF17 76 | C29212190B0470A4CE9F25ED60719AE481A3608B2E8C1C895A9D9E3C1B1B04B3 77 | 1502671406AD595721169F0D8A580B9D8931B68780156A1E859108BAB01DEB89 78 | A585419EC701013BD26FBE89FFD5F4B7EF331E64528EB44E7C765B3A20D8D0DC 79 | D005E2B33FD7AD06D5C307F94F933C78385786ED78398C00BD25D18227ED584F 80 | 39D27C5F7C6E6805F370DE3D875C5D760D24CF2469BC467B1B6583F2D9EE198F 81 | 1DC92763659646F46CBE9044787E6AE461542D5D992C9A262187B34694FED60C 82 | 18CE7051218773B5380736698C1A86F98AA428482F878BAAFBD89BD2FA5B74C9 83 | 0363D9E5E6D4C8B43094DDADAC52A2207C36723883A553EEC5402B904EC080F0 84 | C09B5C9D70ADCFCBF9402F9BDC3C8332B7C20AA1FF138F18849153FE1511466E 85 | 96C78C3062B33C6684119BE5E9853012B33C66047396C7EA6AE8F89CCF40B23C 86 | 340453968719C194B518C296562FFA1DAB1E86896D03C8F2D0104C591E9B5618 87 | 4A0462B69A543D53705C3DE82C0F0DC194E5D9D87068E3778DF087D43E8AC229 88 | A269636E09A3FF477F0824CC426DA9C86BB2CA8698615F20482583D55E13DB06 89 | 98E5A12198B23C2079022796E33F9E25509DE26209963D32494309F486D6370A 90 | BEAC0960D94A9B45231A7B024B863E27B6B1CAF2D0104C591E2C799CF027160E 91 | 108D4650BA019401AE1574414F646F6F01C923C089B63E27B6B1CAF2D01DC994 92 | E5E94158DC74198B4B274B84B997E55B7387C28F0021E45E8387B0EF896DACB2 93 | 3C34045A960723C067E08C62103B41A080228C086B5BDC9B328BE5B3DE1C0A02 94 | D4B94BFA874BDDBABE27B6B1CAF29811CC591E502E324D557E06681FC9F4D519 95 | 2B574BE39D4C08AFCC38299936C59698194059587F53DA74B9CF896DECB23C96 96 | 77675396075743DE0C98A6A7723A67957D610EF34C591E2342F6C70CBDCDF8E5 97 | 93803072B33C869632F87C3C92254FD71D72BAFFA5112F7990DB88973C186184 98 | 4B1E13C2C8953C18C16262DB7097814B1E12813EB1CD548CB122EAFDED90B5D5 99 | 3ACB63963C706BEE4BEF3023D027B6390EC13ACB63963C36F40E33024DF2941F 100 | 161F9D82B338859B81A1549CFF0199E929F85B8968420944650BB51F2A0A0ACA 101 | D510F1DB2D7FACB23C66C96343EFA0DEA97312812E79C88C0DAE3645A8C5E99B 102 | B354A6E72F93EADD27D563358540091D4784FDF2A7CD3ACB63923C36F40E3302 103 | 5DF250E90E901DF9422A7D43657A2A66DCEE9C719B8CE34109617BDB2F7F98B2 104 | 3C46C96343EF3023D0258F3C33BCFD32CE666A4D08A4A9A7DD26A661045FFC8A 105 | 0C200C81FCB1CEF298248F0DBDC38C40973CE03B978B650DC7B13624D33754A6 106 | 27EF7E973BFC81EF8AB7074564A9FB933FAD76C1F55DC8B769AD11E892274B23 107 | C672E700769D1B64FA86CCF4C43794C038997D0874CF8719F14E59EA9649B6E5 108 | 8F8ECB1777AD11AC26B6B15236B677D2193869BCE03EB3157A4F6C63A56CFAD9 109 | 892B049D1B13022792C7B1089C148E10DC5A19113E336EFE60E42264A5759739 110 | 4B50B73337081DFEFC5C890310F4A102AE10D6AC78BC61C8A6DFBBE157B11910 111 | 6465E8C5FDEF7385F07C63477028BF2C37D43F60CDCE8618FB522E6E86FB82DE 112 | 139E3142A2CAE9C52C8F779C873294EE85702765F71A65D9E71F1E8EB76F0272 113 | 5F08329DFE5295531A858043D121C84ED111BAFDC2570589269F14669EF92498 114 | 33844A95E17D678669764382D031277C5570581B4259DC2194CDA95019D6BA67 115 | 7FACBCF8C959DDA5B880F434756AC4CED3A9DADFA55577ED47080EC556D8E0AD 116 | E1D00A9D7B91E1E585E253572E463C222EA6E2394FC6996417170D6E78D0AE48 117 | ABDA36048D7F7877CD9948822B04082A0DFA3214343172938710CF6322A8940E 118 | 350D6B9023DCF2BEB0BF8C7FB5C3DFF513AE105A917EFC8E355F872C202233C2 119 | 7A21A41FB51B81B284C4AE96D3107090648570FBD3FFDB98C7BFFE822C7BDDF7 120 | 2B480471B938979A49F6A0CBC35E84E7E1AFF7266E113AD250B4BADBC54526D5 121 | 9E251D09657717E65233C9AADD79F60EE7212D7D217CEE9C78F0F56F0F56F5DE 122 | 9FF4A141BECFC31502F93342D68EE4FA8BFFB8CEF431FF604018F4FB3C0EB142 123 | 6B0F976E22CFD074304930A4BFB6E5102B981038297D22A4E4D885A033D84298 124 | 3D9408E526846E5F0BBDC00DC2724A37D70CE5EF54559A107E78EAF1495ACC65 125 | 1F024FC0E848ED2545512B117501E70001B7B9246B03C8050FF4A5AFEBBC865B 126 | BFD9818018ADB09CD29C47B8B282AB14CDAE9EA3BAB6342C6172B3CF9684B6F1 127 | 92A1464888EA7645A8EB232716558C2A9D6F5CA83B143E9F1502C446173FCC7A 128 | 67274A41396091949C8E0F071FCBF7E1480951052B30C28971B436E1B6262AA9 129 | 5B076DE164C17C8A22FACE177A460423A419011125CEEF206755F42DC9502398 130 | 6E6D0951695F5A59C102C15430420F555B293B2B801DD246A7F16B9E3A3C1456 131 | 98C81860242C2AEAB1023471F1F85FDA3F5B30EF25F58F49BB455B1441BA5175 132 | C4BBE87CF8AF17DA03D0EEF977DD0F8517A4063FCA9168C77FA358A672D1B67F 133 | 461D14F2C1A55B2A577557CB28F7FD0AFA705EF1F0A94C650AF14F3F498EA659 134 | 82113A80657057262604B827274415BD8611C694CE8FAE28CE38AF4BE03F7FF5 135 | 147477E2898CD423B14B421B74952957EF9F8F56EA124FFE18704CA08F1C0B4B 136 | C7905E8A0D91709F3AE8487EFE01B0DE31C1C4B99702690825A9AEEA92D498AD 137 | 737CBC73BAE18A642782B55EC008662BB8CC7117E443AF9F8FC61E0336814626 138 | 2AA375BFE6FED0A940413AFCCD39F4DB7B3A84119E418F02C146F3BCC983C28E 139 | 6ADF446855DD17FA8873220B471AC2D21782D90A2EDBCECC68ABF1D7D111124A 140 | A275E7330272F1C02011F41139EF5156001BACAAF13FF59FE441CA4F85B0FED5 141 | FA73C38160B6C2A89FC2CFE428136E181148478ABE0548892F1F0E55181150E9 142 | 67BE2A8CA07E130FEB842325E441076222924B238FBC764E2F2DF8B383119653 143 | 5B2BC00ACEE71616FCBBBA55017EFF77A724D7AA9EE10CEB6D7544B0CEB5E677 144 | EC48A217B023E9BF51A8FFECAA6E5D7C8C3C48FAD85753FAE9CE0EDD33E0718E 145 | 44802B52CFBB3C3FF475774E38C0AAFA8412B246EAC6E0582BF4943E622457F5 146 | A34056D57F45650F8D080F255C208C3911A3B28130B4311237084E67AC1138D3 147 | 0BDC20B89C5A55E6B044952502C42AD6E1CAC08B33FFA3CAAC6140C8FDABCE88 148 | 40514078750EEE8A9F2B7E4C1A68AD931FAE6CDCEB788451BFAC555921E8E1FA 149 | BDE09BC1208C4F733C82CBFE8EE43AE2950B705BA1E24623C299F903AFF5E907 150 | 7F8A89753C82ABFFC6AF421BEE86368015C8DBFD2A057E42F5E8D2E4815F019D 151 | F5864A81E311124F1CCB8148910A74A9B8115B01C2AB650366E019900542CFAC 152 | 308E11D6A7E93733220CCA95780DC8F1085FBD9970FFD6BC1BB7E61D303A1285 153 | 302A37D928FB06F6A3FDD1FF703802C41BD1770EB52EB9D02AD55171A3D10ABB 154 | 25CB54C6760CE427FB9D2A040EB742FFC5737219FB568CF98986408D67CE111A 155 | 117A38C7E6BEFAEB7FF8B36EC6B82AE47084FE4BF70DD4157A83A53385EF7B12 156 | 11C668E0E3DB34762DB9E4F6242290174AF4873F9B51EDFCABC0610803506D0F 157 | A793FF1896DD51F6BBAFE50CC92706A16D1CD9FD86036951FD3EE7634068F31C 158 | 7E848E8FF602C077EF2CD9C962678B295564C9E3E875241608445C11B5D0FD5A 159 | 190CE79D39DEF42FD921187F13865B046226DA94C4D4FEAD42DCDA9A58AF32F4 160 | D27584DA17F18B60EDED721302B9892CB54B1B4C07F2048E47882B64EE580D89 161 | A0F1033F88FE0915C52EBF534424E6A5DD34ED4C6E22AB48DC1759663ACE6D18 162 | 10F223C674EE78B51EBA5D1EF471FDCCD1B5D802A93747553FD7B82949E3A779 163 | 6196735397F7EF8FA6AF4F8D2B2216376E0A7AB57E31B5E9FA7F1F99E95566D9 164 | 0B3CC13038D286CFD589FB2226C57714F1BFBBE6A7F123E2F0E256A17F556419 165 | D9D5FB531F89CF0A424EA26577CFFA574578EE8B68A136055686543827827112 166 | 0F3222E4A7A0F12A4738522CBF10FAF159FE24545B50130B37B2B760B11AC602 167 | 742E38FCD999E8DA03D7976F3C382341FB7327E1DD973A17261E844D5F02B0C6 168 | 8F362A707133237479789F71C8588006416B57E67905BFBEFC3FA2E0BB23795E 169 | 41C514026E606570CBB7BBD7EC99E8A94604ECDB83009B341482E5758A86A0F3 170 | 092872CC5898540803F2CBD31E1DFC90EB4D49305061D18C000E53A9BCAA49BC 171 | 7EF362793AB43F761C785D3E7624D8540B8E0497A453B4973D7802F358B839DE 172 | 216381570FFEF26A033466E56BB59A99E0487831EE60A01F85D01EE0D3DC7655 173 | 935560F0F4556D282E8CDBF26A3DDE8B44206038A3FDDBB4B4AAE9080E19CEAC 174 | 4AA45F16EA5859F66D80778FE96CDCE068089CFE9EAAC5ACB0C6FEF65EB31B3E 175 | 165574FD9BEA894460534AF0206FDBB8F72FB92C76362370FB7F910C0C819A2F 176 | 1EFD53FB92A2FE77365F91F2C94FAEDE3A1FCC94AA8797A37CAA07829047C5E6 177 | 979E1C0462EE961816BBB9F54E9170547883C9B5FDB09B851FD1028C271081C5 178 | 2B14021D0D81ABF7FF5820E0986190D54E1C06048891563CA6FB07E884AD7E64 179 | 043BBA96DC61A68BD6B867FF6E04D55ACF47E21C2131AF57D3080AA1E7DBDA8A 180 | 50216B04848601011D8EDB51BE2576038475F22CB0C027D79E8BF199A005DD43 181 | CA9B9018F9DB4893AE55CFF4DA15B39EC59BBB0CAF23718E901777A808C24F7E 182 | 7C477191E605D9DB4818B7A51274CC4C34AD05E4CDC1F6D90D3595CE7371E4C7 183 | C60A3CEB1409E7081ABE6FAC0679BDC89FC45774EC7DCE5B8FC702966E45A41A 184 | 2A425DC2EFFD6ABFC8A5B474BFC5FA0906F7081DEFEEC20D0599139CD4F5F5C2 185 | 1ABFDE0848733D8A05025563AF47615C429811BA02D5B1E30E6299F33889882A 186 | 96BD6D8130EE60DD2C0DF2CBB3E548C6078E86FB1375D4B2C5A330CE18CC08F8 187 | F9C39658AF5D587EE1C7295FFA2D7B701A6B19E42CC45BDEFBFBE8C358407B95 188 | 2D13310D67DAC3E29E7C50AFFF1C99A31131A0BBB3ED5B9DF5535FABFFDF9913 189 | 08DE40244F5F0854252C10FA2A7639990D2BB859548F5D83B9137982BE1EBDB3 190 | 46301703AFD54D37913710260B041E2227730DA2CB98530783407058B1A4E833 191 | EBF32423E062144BB6B2564F3A028BF2E0FF012A88CE5CF0D39AAC0000000049 192 | 454E44AE426082} 193 | Proportional = True 194 | Stretch = True 195 | ExplicitWidth = 387 196 | end 197 | object Panel1: TPanel 198 | Left = 0 199 | Top = 169 200 | Width = 388 201 | Height = 96 202 | Align = alClient 203 | BevelOuter = bvLowered 204 | TabOrder = 0 205 | object Label1: TLabel 206 | Left = 16 207 | Top = 16 208 | Width = 217 209 | Height = 13 210 | Caption = 'Do you want HFS in your shell context menu?' 211 | end 212 | object Button1: TButton 213 | Left = 108 214 | Top = 56 215 | Width = 75 216 | Height = 25 217 | Caption = '&Yes' 218 | Default = True 219 | ModalResult = 6 220 | TabOrder = 0 221 | end 222 | object Button2: TButton 223 | Left = 204 224 | Top = 56 225 | Width = 75 226 | Height = 25 227 | Caption = '&No' 228 | ModalResult = 7 229 | TabOrder = 1 230 | end 231 | end 232 | end 233 | -------------------------------------------------------------------------------- /lib/shellExtDlg.pas: -------------------------------------------------------------------------------- 1 | unit shellExtDlg; 2 | 3 | interface 4 | 5 | uses 6 | Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 7 | Dialogs, ExtCtrls, StdCtrls, utilLib, Vcl.Imaging.pngimage; 8 | 9 | type 10 | TshellExtFrm = class(TForm) 11 | Image1: TImage; 12 | Panel1: TPanel; 13 | Label1: TLabel; 14 | Button1: TButton; 15 | Button2: TButton; 16 | private 17 | { Private declarations } 18 | public 19 | { Public declarations } 20 | end; 21 | 22 | var 23 | shellExtFrm: TshellExtFrm; 24 | 25 | implementation 26 | 27 | {$R *.dfm} 28 | 29 | end. 30 | -------------------------------------------------------------------------------- /listSelectDlg.dfm: -------------------------------------------------------------------------------- 1 | object listSelectFrm: TlistSelectFrm 2 | Left = 0 3 | Top = 0 4 | BorderStyle = bsToolWindow 5 | ClientHeight = 173 6 | ClientWidth = 183 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -11 11 | Font.Name = 'Tahoma' 12 | Font.Style = [] 13 | Position = poMainFormCenter 14 | TextHeight = 13 15 | object listBox: TCheckListBox 16 | Left = 0 17 | Top = 0 18 | Width = 183 19 | Height = 136 20 | Align = alClient 21 | ItemHeight = 17 22 | TabOrder = 0 23 | end 24 | object Panel1: TPanel 25 | Left = 0 26 | Top = 136 27 | Width = 183 28 | Height = 37 29 | Align = alBottom 30 | BevelOuter = bvNone 31 | TabOrder = 1 32 | object okBtn: TButton 33 | Left = 8 34 | Top = 6 35 | Width = 75 36 | Height = 25 37 | Caption = '&OK' 38 | Default = True 39 | ModalResult = 1 40 | TabOrder = 0 41 | end 42 | object cancelBtn: TButton 43 | Left = 96 44 | Top = 6 45 | Width = 75 46 | Height = 25 47 | Caption = '&Cancel' 48 | ModalResult = 2 49 | TabOrder = 1 50 | end 51 | end 52 | end 53 | -------------------------------------------------------------------------------- /listSelectDlg.pas: -------------------------------------------------------------------------------- 1 | unit listSelectDlg; 2 | 3 | interface 4 | 5 | uses 6 | Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 7 | Dialogs, StdCtrls, ExtCtrls, CheckLst, types, strutils; 8 | 9 | type 10 | TlistSelectFrm = class(TForm) 11 | listBox: TCheckListBox; 12 | Panel1: TPanel; 13 | okBtn: TButton; 14 | cancelBtn: TButton; 15 | private 16 | { Private declarations } 17 | public 18 | { Public declarations } 19 | end; 20 | 21 | function listSelect(const title: String; var options: TStringList): Boolean; 22 | 23 | implementation 24 | uses 25 | srvUtils; 26 | 27 | {$R *.dfm} 28 | 29 | function listSelect(const title: String; var options: TStringList): Boolean; 30 | var 31 | dlg: TlistSelectFrm; 32 | i: integer; 33 | begin 34 | result := FALSE; 35 | dlg := TlistSelectFrm.Create(NIL); 36 | with dlg do 37 | try 38 | caption := title; 39 | listBox.items.assign(options); 40 | for i:=0 to options.count-1 do 41 | if options.objects[i] <> NIL then 42 | listbox.Checked[i] := TRUE; 43 | clientHeight := clientHeight-listBox.ClientHeight+listBox.ItemHeight*minmax(5,15, listbox.count); 44 | if showModal() = mrCancel then 45 | exit; 46 | for i:=0 to listbox.Count-1 do 47 | options.Objects[i] := if_(listbox.Checked[i], PTR1, NIL); 48 | result := TRUE; 49 | finally 50 | dlg.free 51 | end; 52 | end; 53 | 54 | end. 55 | -------------------------------------------------------------------------------- /newuserpassDlg.dfm: -------------------------------------------------------------------------------- 1 | object newuserpassFrm: TnewuserpassFrm 2 | Left = 362 3 | Top = 207 4 | BorderStyle = bsDialog 5 | Caption = 'Insert the requested user/pass' 6 | ClientHeight = 131 7 | ClientWidth = 302 8 | Color = clBtnFace 9 | Font.Charset = DEFAULT_CHARSET 10 | Font.Color = clWindowText 11 | Font.Height = -11 12 | Font.Name = 'MS Sans Serif' 13 | Font.Style = [] 14 | Position = poMainFormCenter 15 | OnShow = FormShow 16 | TextHeight = 13 17 | object userBox: TLabeledEdit 18 | Left = 104 19 | Top = 16 20 | Width = 121 21 | Height = 21 22 | EditLabel.Width = 48 23 | EditLabel.Height = 21 24 | EditLabel.Caption = 'Username' 25 | LabelPosition = lpLeft 26 | TabOrder = 0 27 | Text = '' 28 | end 29 | object pwdBox: TLabeledEdit 30 | Left = 104 31 | Top = 40 32 | Width = 121 33 | Height = 21 34 | EditLabel.Width = 46 35 | EditLabel.Height = 21 36 | EditLabel.Caption = 'Password' 37 | LabelPosition = lpLeft 38 | PasswordChar = '*' 39 | TabOrder = 1 40 | Text = '' 41 | end 42 | object pwd2Box: TLabeledEdit 43 | Left = 104 44 | Top = 64 45 | Width = 121 46 | Height = 21 47 | EditLabel.Width = 85 48 | EditLabel.Height = 21 49 | EditLabel.Caption = 'Re-type password' 50 | LabelPosition = lpLeft 51 | PasswordChar = '*' 52 | TabOrder = 2 53 | Text = '' 54 | end 55 | object okBtn: TButton 56 | Left = 104 57 | Top = 96 58 | Width = 75 59 | Height = 25 60 | Caption = '&Ok' 61 | Default = True 62 | TabOrder = 3 63 | OnClick = okBtnClick 64 | end 65 | object resetBtn: TButton 66 | Left = 192 67 | Top = 96 68 | Width = 75 69 | Height = 25 70 | Caption = '&Reset' 71 | TabOrder = 4 72 | OnClick = resetBtnClick 73 | end 74 | end 75 | -------------------------------------------------------------------------------- /newuserpassDlg.pas: -------------------------------------------------------------------------------- 1 | { 2 | Copyright (C) 2002-2012 Massimo Melina (www.rejetto.com) 3 | 4 | This file is part of HFS ~ HTTP File Server. 5 | 6 | HFS is free software; you can redistribute it and/or modify 7 | it under the terms of the GNU General Public License as published by 8 | the Free Software Foundation; either version 2 of the License, or 9 | (at your option) any later version. 10 | 11 | HFS is distributed in the hope that it will be useful, 12 | but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | GNU General Public License for more details. 15 | 16 | You should have received a copy of the GNU General Public License 17 | along with HFS; if not, write to the Free Software 18 | Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 19 | } 20 | unit newuserpassDlg; 21 | 22 | interface 23 | 24 | uses 25 | Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 26 | Dialogs, StdCtrls, ExtCtrls, Vcl.Mask; 27 | 28 | type 29 | TnewuserpassFrm = class(TForm) 30 | userBox: TLabeledEdit; 31 | pwdBox: TLabeledEdit; 32 | pwd2Box: TLabeledEdit; 33 | okBtn: TButton; 34 | resetBtn: TButton; 35 | procedure okBtnClick(Sender: TObject); 36 | procedure resetBtnClick(Sender: TObject); 37 | procedure FormShow(Sender: TObject); 38 | private 39 | { Private declarations } 40 | public 41 | function prompt(var usr,pwd:string):boolean; 42 | end; 43 | 44 | var 45 | newuserpassFrm: TnewuserpassFrm; 46 | 47 | implementation 48 | 49 | {$R *.dfm} 50 | 51 | uses 52 | parserLib, utillib; 53 | 54 | procedure TnewuserpassFrm.okBtnClick(Sender: TObject); 55 | var 56 | error: string; 57 | begin 58 | userBox.text:=trim(userBox.text); 59 | pwdBox.text:=trim(pwdBox.text); 60 | error:=''; 61 | if (userBox.text > '') and not validUsername(userBox.Text) 62 | or (pwdBox.text > '') and not validUsername(pwdBox.text) then 63 | error:='The characters below are not allowed'#13'/\:?*"<>|;&&@' 64 | else if (pwdBox.text > '') and (userBox.text = '') then 65 | error:='User is mandatory' 66 | else if pwdBox.text <> pwd2Box.text then 67 | error:='The two passwords you entered don''t match'; 68 | 69 | if error = '' then ModalResult:=mrOk 70 | else msgDlg(error, MB_ICONERROR); 71 | end; 72 | 73 | procedure TnewuserpassFrm.resetBtnClick(Sender: TObject); 74 | begin 75 | userBox.text:=''; 76 | pwdBox.text:=''; 77 | pwd2Box.text:=''; 78 | end; 79 | 80 | procedure TnewuserpassFrm.FormShow(Sender: TObject); 81 | begin userBox.SetFocus() end; 82 | 83 | function TnewuserpassFrm.prompt(var usr,pwd:string):boolean; 84 | begin 85 | userBox.Text:=usr; 86 | pwdBox.text:=pwd; 87 | pwd2Box.text:=pwd; 88 | result:= ShowModal() = mrOk; 89 | usr:=userBox.Text; 90 | pwd:=pwdBox.text; 91 | end; 92 | 93 | end. 94 | -------------------------------------------------------------------------------- /notes/deprecated.txt: -------------------------------------------------------------------------------- 1 | In the template system, the following %symbols% and [sections] are currently deprecated, because they have been surpassed by {.macros.}. 2 | They are still available for backward compatibilty in 2.x versions, but they are likely not be there since version 3. 3 | 4 | %sym-ANY% 5 | equivalent: {.$sym-ANY.} 6 | note: you are not forced anymore to start the section name by "sym-" 7 | 8 | %up% 9 | equivalent: {.if| {.%folder% = / .} | {.$up.} .} 10 | note: you are not forced anymore in keeping the code inside section [up] 11 | 12 | %item-added% and %item-modified% 13 | equivalent: {.time||when=%item-added-dt%.} 14 | 15 | %new% 16 | equivalent: {.if| {.get|is new.} | {.$newfile.} .} 17 | note: you are not forced anymore in keeping the code inside section [newfile] 18 | 19 | -------------------------------------------------------------------------------- /notes/developer notes.txt: -------------------------------------------------------------------------------- 1 | Initially developed with Delphi 6, now with Delphi 10.3.3 2 | 3 | Icons are generated at http://fontello.com/ . Use fontello.json for further modifications. 4 | 5 | === LIBS USED 6 | ICS v9 by François PIETTE http://www.overbyte.be 7 | TRegExpr v0.952 by Andrey V. Sorokin http://www.regexpstudio.com/TRegExpr/TRegExpr.html 8 | Mormot2 https://github.com/synopse/mORMot2 9 | For.RnQ https://github.com/drapid/rnq/tree/master/for.RnQ 10 | 11 | 12 | Should be added these search paths: 13 | For.rnq 14 | For.rnq\RTL 15 | for.RnQ\zip 16 | mORMot2\src\core 17 | mORMot2\src\crypt 18 | mORMot2\src\lib -------------------------------------------------------------------------------- /notes/notes.txt: -------------------------------------------------------------------------------- 1 | === 4GB+ FILES DOWNLOAD SUPPORT 2 | Reget Deluxe 4.1 3 | MetaProducts Download Express 1.7 4 | Getright 5 | Firefox 2.0 6 | 7 | === 2GB+ FILES UPLOAD SUPPORT 8 | firefox 3.0: no 9 | 10 | === HOW TO CREATE BIG FILES 11 | fsutil file createnew 12 | 13 | === HOW TO DOWNLOAD WITH NO DISK ACTIVITY (SPEED TEST) 14 | create a big file as above 15 | then download this way: wget -q -O nul http://localhost/big 16 | 17 | === SUBMITTED TO 18 | www.nonags.com 19 | www.sharewareconnection.com 20 | 21 | === LISTED ON 22 | www.sofotex.com 23 | www.download3000.com 24 | www.onekit.com 25 | www.all4you.dk/FreewareWorld 26 | www.snapfiles.com 27 | sourceforge 28 | www.freedownloadscenter.com 29 | download.freenet.de 30 | www.softonic.com 31 | www.portablefreeware.com 32 | www.download.com 33 | www.freewarepub.org 34 | www.handyarchive.com 35 | www.softpedia.com 36 | www.acidfiles.com 37 | www.fileedge.com 38 | www.freewarepark.com 39 | 40 | === REVIEWS 41 | http://www.technospot.net/blogs/host-a-web-server-on-your-home-pc/ 42 | http://www.snapfiles.com/get/hfs.html 43 | http://www.downloadsquad.com/2006/05/24/hft-quick-and-easy-http-file-server/ 44 | http://www.caseytech.com/how-to-host-a-web-site-from-your-computer/ 45 | http://www.chip.de/downloads/c1_downloads_29480524.html 46 | http://blog.pcserenity.com/2009/01/easy-conten-sharing-with-windows.html 47 | http://hfs.onehelp.ch 48 | http://www.lanacion.com.ar/nota.asp?nota_id=1148507 49 | http://blogmotion.fr/systeme/partage-windows-hfs-3947 50 | ita 51 | http://lafabbricadibyte.wordpress.com/2007/05/01/hfs-file-server-http-gratuito-per-windows/ 52 | http://server.html.it/articoli/leggi/2335/hfs-file-sharing-via-http/ 53 | 54 | === OTHER SOFTWARE BASED ON HFS 55 | http://www.wrinx.com/products/pfs/ 56 | commercial, licensed 57 | http://www.powernetservers.com/pnwfs.php 58 | commercial, probably unlicensed 59 | 60 | === INSTALLABLE PLUGINS 61 | log links usage 62 | http://www.rejetto.com/forum/index.php/topic,7765.msg1047258.html#msg1047258 63 | -------------------------------------------------------------------------------- /notes/todo.txt: -------------------------------------------------------------------------------- 1 | - update doesn't work without 'only 1 instance' (it's the -q) 2 | + replace shellExtDlg.gif with transparent png (english system) 3 | + self-test supporting https 4 | + expiring links 5 | * dismiss regexp lib http://docwiki.embarcadero.com/Libraries/Rio/en/System.RegularExpressions.TRegEx 6 | + load *.events 7 | + url auth limited to resource 8 | + global limit speed for downloads (browsing excluded) 9 | * consider letting comment "protected" files. Can it really cause harm? 10 | * flag to enable lnk files in a folder (disabled by default) 11 | + sign exe http://www.rejetto.com/forum/hfs-~-http-file-server/'unsafe'/msg1061437/#msg1061437 12 | * cache reReplace 13 | + {.calc.} to have a third numeric parameter that becomes 'x' symbol 14 | + hash&salt passwords 15 | - setInterval > setTimeout 16 | + target=_blank as an option on links 17 | - an unsaved VFS will be asked twice if a restart is caused by an update 18 | + more macros http://www.rejetto.com/forum/index.php/topic,10631.0.html 19 | - long folder names are overflowing the tree-box http://www.rejetto.com/forum/index.php/topic,10631.0.html 20 | + {.vfs delete.} 21 | + log: color upload and downloads http://www.rejetto.com/forum/index.php/topic,10202.0.html 22 | + make simple variables work outside connections http://www.rejetto.com/forum/index.php/topic,9805.msg1054886.html#msg1054886 23 | + {.server stop.} http://www.rejetto.com/forum/index.php/topic,9577.msg1054784.html#msg1054784 24 | + macros missing to cache a folder: {.reply|content=|var=|code=|filename=|mime=.} 25 | - unexpected scripting behavior http://www.rejetto.com/forum/index.php/topic,9728.msg1054517.html#msg1054517 26 | in handleItem() translate only symbols, and run all macros at the end 27 | document: [section|ver=MASK|build=MIN-MAX|template=MASK] 28 | document: {.if|var} 29 | document: {.exec|out|timeout|exitcode.} 30 | document: [+section] 31 | document: {.set item|diff template.} 32 | document: {.add header|overwrite=0.} 33 | document: {.calc| ][ } 34 | document: single line diff templates (file path) 35 | document: {.disconnection reason|if=XXX.} 36 | document: %url% 37 | document: commands returning white space: add folder, save, set account, exec, mkdir, chdir, delete, rename, move copy, set 38 | document: pipe, base64, base64decode, dir, disk free, filetime, file changed, load tpl, sha256, for line 39 | document {.convert|macros|dec|hex.} 40 | document: new event [login] 41 | + event to filter logging http://www.rejetto.com/forum/index.php/topic,9784.0.html 42 | - wrong browser http://www.rejetto.com/forum/index.php/topic,9710.0.html 43 | solution: 44 | read HKEY_CURRENT_USER\Software\Microsoft\Windows\Shell\Associations\UrlAssociations\http\UserChoice::Progid 45 | read ROOT\$program-id\shell\open\command::Default 46 | * findExtOnStartupChk, when failing, is not reporting the server 47 | - better dialog message http://www.rejetto.com/forum/index.php/topic,9778.0.html 48 | + upload to non-browsable folder 49 | - android doesn't upload http://www.rejetto.com/forum/index.php/topic,9699.0/topicseen.html#msg1054287 50 | - android doesn't work with passwords http://www.rejetto.com/forum/index.php/topic,9575.msg1054029.html#msg1054029 51 | ? default tpl: consider css data uri http://www.nczonline.net/blog/2010/07/06/data-uris-make-css-sprites-obsolete/ 52 | + next VFS file format version should be text (yaml or json) 53 | + remove the "progress" from "log what", and use [progress|no log] instead 54 | + folder archive depth limit http://www.rejetto.com/forum/index.php/topic,8546.msg1050027.html#msg1050027 55 | ? in getPage() many %symbols% are translated in a way incompatible with {.section.} 56 | ? Windows Script Interfaces 57 | ? {.image|src=file|width=x|dst=outfile.} 58 | + user input through {.dialog.} or similar 59 | + show missing files in VFS http://www.rejetto.com/forum/index.php/topic,8203.new.html 60 | * {.cache.} should be able to work on a simple variable 61 | + plugins system http://www.rejetto.com/wiki/index.php/HFS:_plugins_design 62 | ? tpl as plugin category 63 | ? try merging 2 implementations of runEventScript() 64 | + support PUT http method 65 | ? use the system index for faster searching http://msdn.microsoft.com/en-us/library/bb266517(VS.85).aspx http://www.rejetto.com/forum/index.php/topic,7700.msg1047024.html#msg1047024 66 | - out of memory / GDI http://www.rejetto.com/forum/index.php/topic,7703.msg1047118.html#msg1047118 67 | ? consider using tpl.appendString() in getFolderPage() instead of getRecursiveDiffTplAsStr() to avoid some string concatenations 68 | ? fake the by-default "anyone" in permission/download, to reflect the behavior www.rejetto.com/forum/?topic=7301 69 | + log event to filter www.rejetto.com/forum/?topic=7332.0 70 | ? integration with mediainfo.dll www.rejetto.com/forum/?topic=7329 71 | + folder archive log, just as for deletion http://www.rejetto.com/forum/index.php?topic=6904.msg1042974;topicseen#msg1042974 72 | - AV with RealVNC on hints by mouse hovering www.rejetto.com/forum/?topic=5261 73 | - N-Stalker can locally crash HFS 74 | - AV in #179 http://www.rejetto.com/forum/index.php?topic=5653.msg1033457#msg1033457 www.rejetto.com/forum/?topic=5681 75 | - AV in #184 http://www.rejetto.com/forum/index.php?topic=5792.msg1034538#msg1034538 76 | - AV in #185 http://www.rejetto.com/forum/indebx.php?topic=5795.msg1034536#msg1034536 www.rejetto.com/forum/?topic=5873 77 | - focus problem hovering this hint http://www.rejetto.com/forum/index.php?topic=6321.msg1038272#msg1038272 78 | - lock icon is lost on moving http://www.rejetto.com/forum/index.php?topic=6371.msg1038531#msg1038531 79 | - there seems to be problems with SMB resources www.rejetto.com/forum/?topic=6365 80 | - malfunctions with incorrect timestamps http://www.rejetto.com/forum/index.php?topic=6418.msg1039179#msg1039179 81 | ? permission events www.rejetto.com/forum/?topic=6698 82 | - show error message http://www.rejetto.com/forum/index.php?topic=6695.msg1041212#msg1041212 83 | - AV deleting files in #221 www.rejetto.com/forum/?topic=6629 84 | + "no download" should become a permission http://www.rejetto.com/forum/index.php?topic=6870.msg1042583#msg1042583 85 | + http://www.rejetto.com/forum/index.php?topic=6719.msg1041559#msg1041559 86 | + link properties: "open in new window" 87 | + authentication digest 88 | + improve the connections box http://www.rejetto.com/forum/index.php?topic=6689.msg1041182#msg1041182 89 | + ban page can't eventually access template files www.rejetto.com/forum/?topic=6628 90 | + support POSTed files www.rejetto.com/forum/?topic=6618 91 | + clicking on a group, user should get notified of what accounts are part of it 92 | + multi-span folder archive www.rejetto.com/forum/?topic=6575 93 | + an updated hint on virtual folders, to explain how to get upload working 94 | - requesting a non-existant file inside an unauthorized folder, apache replies 401, hfs 404. try to comply. 95 | + make %list% available in every page 96 | + support for ALT+F4 with option "Minimize to tray clicking the close button" www.rejetto.com/forum/?topic=6351 97 | + replace and delete icons http://www.rejetto.com/forum/index.php?topic=6317.msg1038157#msg1038157 98 | ? currently the delete permission is only inside a folder. you can't mark a file or delete the marked folder. is this ok? 99 | + when a link is protected (no access for this user) it may be displayed as a link to the %item-name%, then 401, and if login is successful provide a redirection 100 | + change folder/link/generic-file icons (via GUI, without editing the template) 101 | + a way to get bigger icons (client side) 102 | + be able to produce rss http://www.rejetto.com/forum/index.php?topic=5846.msg1035481#msg1035481 103 | * better warning message http://www.rejetto.com/forum/index.php?topic=5795.msg1034406#msg1034406 104 | ? on the fly files compression www.rejetto.com/forum/?topic=5492 105 | ? firewall mode www.rejetto.com/forum/?topic=5461 106 | ? auto-removing folders www.rejetto.com/forum/?topic=3149 107 | + last-access-time for files www.rejetto.com/forum/?topic=5266 108 | + expiration time for account www.rejetto.com/forum/?topic=5409 109 | + warn the user if there's no useful IP address http://www.rejetto.com/forum/index.php?topic=3193.msg1031371#msg1031371 110 | + GUI suggestions www.rejetto.com/forum/?topic=5334 111 | + {.cookie.} http://www.rejetto.com/forum/index.php?topic=5349.0 112 | + restrict access to -> ip mask www.rejetto.com/forum/?topic=5244 113 | + an option to not consider LAN traffic graph/statistics http://www.rejetto.com/forum/index.php?topic=5244.msg1030090#msg1030090 114 | + url command to save the output in a cache, given an ID an an expiry time (minutes?) http://www.rejetto.com/forum/index.php?topic=5239.msg1030223#msg1030223 115 | + ban list sorting (maybe always sort?) www.rejetto.com/forum/?topic=5251 116 | ? shutdown message www.rejetto.com/forum/?topic=3206 117 | + a variant of ?limit to trim after full listing (rename limit? the other method recalls the SQL limit, would fit better) http://www.rejetto.com/forum/index.php?topic=5196.msg1029734#msg1029734 118 | + show update news inside HFS 119 | + a way to filter/show only "new" files www.rejetto.com/forum/?topic=5227 120 | ? add to the LOG the X-REQUEST To to be able to know whom the proxy is forwarding to 121 | + a way to add via cmdline a file specifying its virtual name/path 122 | ? "sticky file" with an hint on adding a leading blank space www.rejetto.com/forum/?topic=5088 123 | + upload file overwriting per-folder www.rejetto.com/forum/?topic=5086 124 | + https 125 | + filter mask based on host, to disconnect who is not using our dyndns 126 | + mouse hovering the graph, shows the speed and time for that point 127 | + per-folder no-limit 128 | + windows auth (NLTM? seems to be available in ICS) www.rejetto.com/forum/?topic=3762 129 | + more stats www.rejetto.com/forum/?topic=4968 130 | + to disable single ban rules 131 | + ban by hostname 132 | + edit comments for real folders www.rejetto.com/forum/?topic=4667 133 | + a way to pass ini commands through the command line 134 | + create folders via command line www.rejetto.com/forum/?topic=3955 135 | ? support mp3ToIon www.rejetto.com/forum/?topic=4600 136 | + download only for 137 | + account: see all transfers in ~progress http://www.rejetto.com/forum/index.php/topic,9325.msg1053416/topicseen.html#msg1053416 138 | + limit account to a host mask 139 | + tray icons for uploads 140 | + MAC filter 141 | + if robots.txt does not exist, an option "don't be listed on search engines" 142 | + menu -> limits -> temporarily disable all limits 143 | + menu -> limits -> max speed for each address 144 | + option to display counter for folders as number of accesses instead of total access to files in it 145 | + autodisabling accounts www.rejetto.com/forum/?topic=5379 146 | + on update, propose a link to the "what's new" page 147 | + add special folder (expert mode): let you specify a special folder, like documents, or manually enter a path (useful for relative paths), or GUID 148 | + logs rotation (hfs always append) 149 | + double address bar, one for LAN and one for the Internet 150 | + per user diff-tpl (apply both folder and user diff-tpl.s, and let the user decide priority, default:user,folder) 151 | + "Folder image mask", a file mask indicating the external file that should be used as icon (~img_folder) 152 | + to be able to add icons from multi-icon files (like shell32.dll) 153 | + installer (saving to registry, and making ini-file the new default, don't ask for shell menu) 154 | + support unicode filenames (FindFirstFileW. Cannot be done because widgets don't support unicode) 155 | * show "(home)" instead of "/" in VFS 156 | + show updateinfo notice also in autocheck 157 | + top 10 downloaded files 158 | + after the self test fails, and a router problem is detected, prompt a wizard for portforwad.com (extract routers list) 159 | + export vfs map as txt/html 160 | + specific message for each disabled account 161 | + search for files including meta information (id3 tag) www.rejetto.com/forum/?topic=5312 162 | + multiupload using flash 163 | ? support shortcut to folders in real-folders 164 | * save custom icons in VFS only once 165 | + DNS reverse for ips www.rejetto.com/forum/?topic=4970 166 | + UPnP (www.upnpworks.alcidelic.com/links.html) (www.whitebear.ch) (http://miniupnp.free.fr/) (http://miniupnp.free.fr/files/xchat-upnp20061022.patch) 167 | + UPnP Media Server www.rejetto.com/forum/?topic=5538 168 | + save to registry in different strings 169 | + loading cfg, if version < current then warn user 170 | + auto-ban IP if: bad login X times (with IP exclusion mask) [macros?] 171 | + deny listing and download for uploading files 172 | + download/upload quota (global and account-based) 173 | + purge VFS from unexistant items: files, real folders, virtual folders, empty folders 174 | + custom browser [with an help on how to get a new browser window] 175 | + admin panel (with stats, and maybe commands) 176 | + limit bandwidth/downloads/kb by user, by ip 177 | + external text files with list of authorized IP addresses/accounts 178 | + periodic password changer? (t=1061) 179 | + thumbnails mode (create thumbnails on addition) 180 | ? socks5 181 | + SSI 182 | + support file renaming notification 183 | + multi-language 184 | + zip format for folder archives 185 | * stop using /~commands and move all of them in the standard ?name=value form 186 | 187 | VER 3 188 | + new kind of folder (no more real/virtual folders) 189 | 190 | VER 3.5 191 | + search for files 192 | + file/folder properties in a window (collect menu commands) 193 | + undo (multilevel) 194 | 195 | VER 4 196 | + PHP/ASP via CGI (http://cgi-spec.golux.com/) 197 | 198 | VER 5 199 | + ftp / webdav 200 | -------------------------------------------------------------------------------- /recompile data.bat: -------------------------------------------------------------------------------- 1 | @ECHO OFF 2 | BuiltTime.exe 3 | @REM Copy rsvars.bat from Delphi bin directory 4 | @ECHO SET variable D_COMPONENTS with path for components 5 | @call rsvars.bat 6 | @ECHO compiling 7 | %BDS%\bin\brcc32 res\data.rc -fodata.res 8 | exit; 9 | 10 | %BDS%\bin\dcc32.exe hfs.dpr -$W+ --no-config -M -Q -TX.exe -AForms=VCL.Forms;Generics.Collections=System.Generics.Collections;Generics.Defaults=System.Generics.Defaults;WinTypes=Winapi.Windows;WinProcs=Winapi.Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE -DDEBUG -DUSE_SYMCRYPTO -I"%BDS%\Lib\Debug";"%BDS%\lib\Win32\release";%USERPROFILE%\Documents\Embarcadero\Studio\20.0\Imports;"%BDS%\Imports";C:\Users\Public\Documents\Embarcadero\Studio\20.0\Dcp;"%BDS%\include";srv;..\RnQ\For.RnQ;%D_COMPONENTS%\other\compiled;%D_COMPONENTS%\fastmm4;%D_COMPONENTS%\kdl;%D_COMPONENTS%\ICSv8\source;%D_COMPONENTS%\jcl\source\windows;%D_COMPONENTS%\jcl\source\include;%D_COMPONENTS%\jcl\source\common -LEC:\Users\Public\Documents\Embarcadero\Studio\20.0\Bpl -LNC:\Users\Public\Documents\Embarcadero\Studio\20.0\Dcp -NSData.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;Winapi;System.Win; -O"%BDS%\Lib\Debug";"%BDS%\lib\Win32\release";"%BDS%\Imports";C:\Users\Public\Documents\Embarcadero\Studio\20.0\Dcp;"%BDS%\include";jcl;srv;..\RnQ\For.RnQ;..\RnQ\For.RnQ\zip;..\RnQ\For.RnQ\RTL;..\RnQ\for.RnQ\External\mORMot2\src\core;..\RnQ\for.RnQ\External\mORMot2\src\crypt;%D_COMPONENTS%\ICSv8\source;%D_COMPONENTS%\jcl\source\windows;%D_COMPONENTS%\jcl\source\include;%D_COMPONENTS%\jcl\source\common -R"%BDS%\Lib\Debug";"%BDS%\lib\Win32\release";"%BDS%\Imports";C:\Users\Public\Documents\Embarcadero\Studio\20.0\Dcp;"%BDS%\include";jcl;srv;..\RnQ\For.RnQ;..\RnQ\For.RnQ\zip;..\RnQ\For.RnQ\RTL;..\RnQ\for.RnQ\External\mORMot2\src\core;..\RnQ\for.RnQ\External\mORMot2\src\crypt;%D_COMPONENTS%\ICSSv8\source;%D_COMPONENTS%\jcl\source\windows;%D_COMPONENTS%\jcl\source\include;%D_COMPONENTS%\jcl\source\common -U"%BDS%\Lib\Debug";"%BDS%\lib\Win32\release";"%BDS%\Imports";C:\Users\Public\Documents\Embarcadero\Studio\20.0\Dcp;"%BDS%\include";jcl;srv;..\RnQ\For.RnQ;..\RnQ\For.RnQ\zip;..\RnQ\For.RnQ\RTL;..\RnQ\for.RnQ\External\mORMot2\src\core;..\RnQ\for.RnQ\External\mORMot2\src\crypt;%D_COMPONENTS%\ICSv8\source;%D_COMPONENTS%\jcl\source\windows;%D_COMPONENTS%\jcl\source\include;%D_COMPONENTS%\jcl\source\common -K00400000 --description:"HFS ~ HTTP File Server - www.rejetto.com/hfs" -GD -NBC:\Users\Public\Documents\Embarcadero\Studio\20.0\Dcp -NOUnits -NUUnits -NHC:\Users\Public\Documents\Embarcadero\Studio\20.0\hpp\Win32 11 | 12 | exit; 13 | %BDS%\bin\dcc32.exe hfs.dpr -$W+ --no-config -M -Q -TX.exe -AForms=VCL.Forms;Generics.Collections=System.Generics.Collections;Generics.Defaults=System.Generics.Defaults;WinTypes=Winapi.Windows;WinProcs=Winapi.Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE 14 | -DDEBUG -DUSE_SYMCRYPTO 15 | -I"%BDS%\Lib\Debug";"%BDS%\lib\Win32\release";%USERPROFILE%\Documents\Embarcadero\Studio\20.0\Imports;"%BDS%\Imports";C:\Users\Public\Documents\Embarcadero\Studio\20.0\Dcp;"%BDS%\include";..\RnQ\For.RnQ;%D_COMPONENTS%\other\compiled;%D_COMPONENTS%\fastmm4;%D_COMPONENTS%\kdl;%D_COMPONENTS%\icsv9\source;lib; 16 | -LEC:\Users\Public\Documents\Embarcadero\Studio\20.0\Bpl 17 | -LNC:\Users\Public\Documents\Embarcadero\Studio\20.0\Dcp 18 | -NSData.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;Winapi;System.Win; 19 | -O"%BDS%\Lib\Debug";"%BDS%\lib\Win32\release";"%BDS%\Imports";C:\Users\Public\Documents\Embarcadero\Studio\20.0\Dcp;"%BDS%\include";jcl;..\RnQ\For.RnQ;..\RnQ\For.RnQ\zip;..\RnQ\For.RnQ\RTL;..\RnQ\for.RnQ\External\mORMot2\src\core;%D_COMPONENTS%\icsv9\source;lib;srv; 20 | -R"%BDS%\Lib\Debug";"%BDS%\lib\Win32\release";"%BDS%\Imports";C:\Users\Public\Documents\Embarcadero\Studio\20.0\Dcp;"%BDS%\include";jcl;..\RnQ\For.RnQ;..\RnQ\For.RnQ\zip;..\RnQ\For.RnQ\RTL;..\RnQ\for.RnQ\External\mORMot2\src\core;%D_COMPONENTS%\icsv9\source;lib;srv; 21 | -U"%BDS%\Lib\Debug";"%BDS%\lib\Win32\release";"%BDS%\Imports";C:\Users\Public\Documents\Embarcadero\Studio\20.0\Dcp;"%BDS%\include";jcl;..\RnQ\For.RnQ;..\RnQ\For.RnQ\zip;..\RnQ\For.RnQ\RTL;..\RnQ\for.RnQ\External\mORMot2\src\core;%D_COMPONENTS%\icsv9\source;lib;srv; 22 | -K00400000 --description:"HFS ~ HTTP File Server - www.rejetto.com/hfs" -GD -NBC:\Users\Public\Documents\Embarcadero\Studio\20.0\Dcp -NOUnits -NUUnits 23 | -NHC:\Users\Public\Documents\Embarcadero\Studio\20.0\hpp\Win32 24 | -------------------------------------------------------------------------------- /res/NoMacros.tpl: -------------------------------------------------------------------------------- 1 | [] 2 | 3 | %folder% 4 | 5 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 |
15 | 22 | 23 | 113 | 114 |
115 |
🏠%folder%
116 |
%files%
117 | 118 | 119 | 121 | 122 | 123 | [files] 124 | 125 | 126 | 127 |
Sort Name, Type, Date   
128 |
Files for download: 
129 |
%list%
 130 | 131 | [special:alias|cache] 132 | 133 | [file.jpg = file.JPG = file.jpeg = file.png = file.gif = file.tif = file.bmp = file.webp] 134 |
📷 %item-name% 135 | %item-modified%, %item-size%
136 | 137 | [file.mp4 = file.m4v = file.mkv = file.flv = file.avi = file.wmv = file.webm = file.mov] 138 |
🎥 %item-name% 139 | %item-modified%, %item-size%
140 | 141 | [file.mp3 = file.m4a = file.wma = file.flac = file.ogg = file.aac] 142 |
🔊 %item-name% 143 | %item-modified%, %item-size%
144 | 145 | [file.doc = file.odt = file.docx = file.xls = file.ods = file.xlsx = file.pdf = file.mobi = file.epub = file.lit = file.txt] 146 |
📄 %item-name% 147 | %item-modified%, %item-size%
148 | 149 | [file] 150 |
🔷 %item-name% 151 | %item-modified%, %item-size%
152 | 153 | [link] 154 |
🔗 %item-name% 155 | link 
156 | 157 | [folder] 158 |
159 | 📁 %item-name% 160 | %item-modified%
161 | 162 | [nofiles] 163 | %url%
⇦ Back 164 | 165 | [api level] 166 | 999 167 | 168 | [error-page] 169 | %content% 170 | 171 | [overload] 172 | 173 | [max contemp downloads] 174 | 175 | [server is busy|public] 176 | 177 | Busy 178 |


Server is busy.

Returning to previous page...
179 | 180 | [not found] 181 | 182 | 404 183 |


Folder Not Found.

Returning to previous page...
184 | 185 | [404|public] 186 | 187 | 404 188 |


File Not Found.

Returning to previous page...
189 | 190 | [unauth] 191 | 192 | [deny] 193 | 194 | [ban] 195 | 196 | [upload|public] 197 | Upload to: %folder% 198 | 199 | 200 | 201 | 202 | Upload to: %folder%
⇦ Back



203 | Upload is not available to due to high server load.

Automatically retrying in seconds...

204 | 205 | :}|{: 206 |
Upload to: %folder%
⇦ Back

You can upload files into the
%diskfree% available space.

207 |
First:

 + 

And then:
Results page appears after uploads complete
208 | 209 | 210 | [upload-results] 211 | 212 | 213 | Upload results for: %folder% 214 | 215 |
Upload results for: %folder%
%uploaded-files%

⇦ Back
216 | 217 | [upload-success] 218 | SUCCESS! Uploaded: %item-name% - %item-size% 219 | 220 | [upload-failed] 221 | Error: %item-name%: - %reason% 222 | 223 | [special:import] 224 | 225 | [+special:strings] 226 | option.comment=0 227 | 228 | [newfile] 229 | 230 | [ajax.changepwd|public|no log] 231 | 232 | [login|public] 233 | 234 | -------------------------------------------------------------------------------- /res/RapidD.public: -------------------------------------------------------------------------------- 1 | { 2 | "Version": 1, 3 | "Serial": "44069D67AF0C8D47260FC6D54CF8D7D8", 4 | "Issuer": "rapid d", 5 | "IssueDate": "2022-05-18", 6 | "ValidityStart": "2022-05-01", 7 | "ValidityEnd": "2036-01-08", 8 | "AuthoritySerial": "44069D67AF0C8D47260FC6D54CF8D7D8", 9 | "AuthorityIssuer": "rapid d", 10 | "IsSelfSigned": true, 11 | "Base64": "AQBECDMIuxtEBp1nrwyNRyYPxtVM+NfYUOxkkSAAAAAAAAAAAAAAAEQGnWevDI1HJg/G1Uz419hQ7GSRIAAAAAAAAAAAAAAAAjFtx1cv3TMLgsf6vpKPe0Fyn3N+lBcvJ5p0wsR30LN50kuPgTMOvB5xVtagqaKSWs3uCEmOvwPLXMLPbMZaQM9o9p+Pucwtd8RgSEfIJR8rIBrfXQQjAJn1t6pvam9YhyXGsWIgAAAA+1Bfb+5Ie5viQLWyC/36BXo5/Xs1DRtEVhE+U8Pwm7w=" 12 | } -------------------------------------------------------------------------------- /res/WindowsXP.manifest: -------------------------------------------------------------------------------- 1 | 2 | 3 | 8 | Windows Shell 9 | 10 | 11 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 31 | True/PM 32 | 33 | 34 | 35 | -------------------------------------------------------------------------------- /res/alias.txt: -------------------------------------------------------------------------------- 1 | var length=length|var=$1 2 | cache=trim|{.set|#cache.tmp|{.from table|$1|$2.}.} {.if not|{.^#cache.tmp.}|{:{.set|#cache.tmp|{.dequote|$3.}.}{.set table|$1|$2={.^#cache.tmp.}.}:}.} {.^#cache.tmp.} {.set|#cache.tmp.} 3 | is substring=pos|$1|$2 4 | set append=set|$1|$2|mode=append 5 | 123 if 2=if|$2|$1$2$3 6 | between=if|{.$1 < $3.}|{:{.and|{.$1 <= $2.}|{.$2 <= $3.}:}|{:{.and|{.$3 <= $2.}|{.$2 <= $1.}:} 7 | between!=if|{.$1 < $3.}|{:{.and|{.$1 < $2.}|{.$2 < $3.}:}|{:{.and|{.$3 < $2.}|{.$2 < $1.}:} 8 | file changed=if| {.{.filetime|$1.} > {.^#file changed.$1.}.}|{: {.set|#file changed.$1|{.filetime|$1.}.} {.if|$2|{:{.load|$1|var=$2.}:}.} 1:} 9 | play system event=play 10 | redirect=add header|Location: $1 11 | chop={.cut|{.calc|{.pos|$2|var=$1.}+{.length|$2.}.}||var=$1|remainder=#chop.tmp.}{.^#chop.tmp.} -------------------------------------------------------------------------------- /res/data.rc: -------------------------------------------------------------------------------- 1 | 1 24 "WindowsXP.manifest" 2 | defaultTpl TEXT default.tpl 3 | // dmBrowserTpl TEXT dmBrowser.tpl 4 | // defaultTpl ZTEXT default.tpl.gz 5 | dmBrowserTpl ZTEXT dmBrowser.tpl.gz 6 | filelistTpl TEXT filelist.tpl 7 | noMacrosTpl TEXT NoMacros.tpl 8 | alias TEXT alias.txt 9 | IPservices TEXT ipservices.txt 10 | // jquery TEXT jquery.min.js 11 | jquery ZTEXT jquery.min.js.gz 12 | //numbers IMAGE numbers.png 13 | numbers32 IMAGE numbers32.png 14 | RDpubkey TEXT RapidD.public -------------------------------------------------------------------------------- /res/dmBrowser.tpl: -------------------------------------------------------------------------------- 1 | 2 | 3 | HFS %folder% 4 | 5 | %up% 6 | %files% 7 | 8 | 9 | 10 | [up] 11 | UP 12 | 13 | [nofiles] 14 |
No files
15 | 16 | [files] 17 | %list% 18 | 19 | [file] 20 | %item-name% 21 | 22 | [folder] 23 | %item-name% 24 | 25 | [comment] 26 |
%item-comment%
27 | 28 | [error-page] 29 | 30 | %content% 31 | 32 | 33 | 34 | [not found] 35 |

404 - Not found

36 | go to root 37 | 38 | [overload] 39 |

Server busy

40 | Please, retry later. 41 | -------------------------------------------------------------------------------- /res/dmBrowser.tpl.gz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/drapid/HFS/06a40abe58c47b63bbe60fd63767d33c123d8d44/res/dmBrowser.tpl.gz -------------------------------------------------------------------------------- /res/filelist.tpl: -------------------------------------------------------------------------------- 1 | %files% 2 | 3 | [files] 4 | %list% 5 | 6 | [file] 7 | %item-full-url% 8 | 9 | [folder] 10 | %item-full-url% 11 | 12 | -------------------------------------------------------------------------------- /res/fontello.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "", 3 | "css_prefix_text": "fa-", 4 | "css_use_suffix": false, 5 | "hinting": true, 6 | "units_per_em": 1000, 7 | "ascent": 850, 8 | "glyphs": [ 9 | { 10 | "uid": "823a9e02e643318116fea40a00190e4e", 11 | "css": "asterisk", 12 | "code": 59392, 13 | "src": "fontawesome" 14 | }, 15 | { 16 | "uid": "43ab845088317bd348dee1d975700c48", 17 | "css": "check-circled", 18 | "code": 59393, 19 | "src": "fontawesome" 20 | }, 21 | { 22 | "uid": "8b80d36d4ef43889db10bc1f0dc9a862", 23 | "css": "user", 24 | "code": 59394, 25 | "src": "fontawesome" 26 | }, 27 | { 28 | "uid": "598a5f2bcf3521d1615de8e1881ccd17", 29 | "css": "clock", 30 | "code": 59395, 31 | "src": "fontawesome" 32 | }, 33 | { 34 | "uid": "9a76bc135eac17d2c8b8ad4a5774fc87", 35 | "css": "download", 36 | "code": 59396, 37 | "src": "fontawesome" 38 | }, 39 | { 40 | "uid": "eeec3208c90b7b48e804919d0d2d4a41", 41 | "css": "upload", 42 | "code": 59397, 43 | "src": "fontawesome" 44 | }, 45 | { 46 | "uid": "98d9c83c1ee7c2c25af784b518c522c5", 47 | "css": "ban", 48 | "code": 59398, 49 | "src": "fontawesome" 50 | }, 51 | { 52 | "uid": "d35a1d35efeb784d1dc9ac18b9b6c2b6", 53 | "css": "edit", 54 | "code": 59399, 55 | "src": "fontawesome" 56 | }, 57 | { 58 | "uid": "dd6c6b221a1088ff8a9b9cd32d0b3dd5", 59 | "css": "check", 60 | "code": 59400, 61 | "src": "fontawesome" 62 | }, 63 | { 64 | "uid": "f8aa663c489bcbd6e68ec8147dca841e", 65 | "css": "folder", 66 | "code": 59401, 67 | "src": "fontawesome" 68 | }, 69 | { 70 | "uid": "197375a3cea8cb90b02d06e4ddf1433d", 71 | "css": "globe", 72 | "code": 59402, 73 | "src": "fontawesome" 74 | }, 75 | { 76 | "uid": "d7271d490b71df4311e32cdacae8b331", 77 | "css": "home", 78 | "code": 59403, 79 | "src": "fontawesome" 80 | }, 81 | { 82 | "uid": "f2aa28a2548ed3d2be718d087b65ee21", 83 | "css": "key", 84 | "code": 59404, 85 | "src": "fontawesome" 86 | }, 87 | { 88 | "uid": "c1f1975c885aa9f3dad7810c53b82074", 89 | "css": "lock", 90 | "code": 59405, 91 | "src": "fontawesome" 92 | }, 93 | { 94 | "uid": "a73c5deb486c8d66249811642e5d719a", 95 | "css": "refresh", 96 | "code": 59406, 97 | "src": "fontawesome" 98 | }, 99 | { 100 | "uid": "09feb4465d9bd1364f4e301c9ddbaa92", 101 | "css": "retweet", 102 | "code": 59407, 103 | "src": "fontawesome" 104 | }, 105 | { 106 | "uid": "474656633f79ea2f1dad59ff63f6bf07", 107 | "css": "star", 108 | "code": 59408, 109 | "src": "fontawesome" 110 | }, 111 | { 112 | "uid": "0f4cae16f34ae243a6144c18a003f2d8", 113 | "css": "cancel-circled", 114 | "code": 59409, 115 | "src": "fontawesome" 116 | }, 117 | { 118 | "uid": "7f3d8ff1d5f6ee019f0c00ed7a86caec", 119 | "css": "truck", 120 | "code": 59410, 121 | "src": "fontawesome" 122 | }, 123 | { 124 | "uid": "559647a6f430b3aeadbecd67194451dd", 125 | "css": "menu", 126 | "code": 61641, 127 | "src": "fontawesome" 128 | }, 129 | { 130 | "uid": "3a26448b711645ba1abfc86c1a6e2f30", 131 | "css": "coffee", 132 | "code": 61684, 133 | "src": "fontawesome" 134 | }, 135 | { 136 | "uid": "ab95e1351ebaec5850101097cbf7097f", 137 | "css": "quote-left", 138 | "code": 61709, 139 | "src": "fontawesome" 140 | }, 141 | { 142 | "uid": "e80ae555c1413a4ec18b33fb348b4049", 143 | "css": "file-archive", 144 | "code": 61894, 145 | "src": "fontawesome" 146 | }, 147 | { 148 | "uid": "bbfb51903f40597f0b70fd75bc7b5cac", 149 | "css": "trash", 150 | "code": 61944, 151 | "src": "fontawesome" 152 | }, 153 | { 154 | "uid": "818981e2ad316f18ae61cfa805d41309", 155 | "css": "user-circle", 156 | "code": 62141, 157 | "src": "fontawesome" 158 | }, 159 | { 160 | "uid": "5278ef7773e948d56c4d442c8c8c98cf", 161 | "css": "lightbulb", 162 | "code": 61675, 163 | "src": "fontawesome" 164 | }, 165 | { 166 | "uid": "56a21935a5d4d79b2e91ec00f760b369", 167 | "css": "sort", 168 | "code": 61660, 169 | "src": "fontawesome" 170 | }, 171 | { 172 | "uid": "0cd2582b8c93719d066ee0affd02ac78", 173 | "css": "sort-alt-up", 174 | "code": 61792, 175 | "src": "fontawesome" 176 | }, 177 | { 178 | "uid": "27b13eff5eb0ca15e01a6e65ffe6eeec", 179 | "css": "sort-alt-down", 180 | "code": 61793, 181 | "src": "fontawesome" 182 | }, 183 | { 184 | "uid": "9dd9e835aebe1060ba7190ad2b2ed951", 185 | "css": "search", 186 | "code": 59411, 187 | "src": "fontawesome" 188 | }, 189 | { 190 | "uid": "0d20938846444af8deb1920dc85a29fb", 191 | "css": "logout", 192 | "code": 59412, 193 | "src": "fontawesome" 194 | } 195 | ] 196 | } -------------------------------------------------------------------------------- /res/hfs_Icon.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/drapid/HFS/06a40abe58c47b63bbe60fd63767d33c123d8d44/res/hfs_Icon.ico -------------------------------------------------------------------------------- /res/ipservices.txt: -------------------------------------------------------------------------------- 1 | http://hfsservice.rejetto.com/ip.php|! 2 | http://checkip.dyndns.org|: 3 | http://checkip.amazonaws.com| 4 | http://whatismyip.akamai.com| 5 | http://bot.whatismyipaddress.com| 6 | -------------------------------------------------------------------------------- /res/jquery.min.js.gz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/drapid/HFS/06a40abe58c47b63bbe60fd63767d33c123d8d44/res/jquery.min.js.gz -------------------------------------------------------------------------------- /res/numbers.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/drapid/HFS/06a40abe58c47b63bbe60fd63767d33c123d8d44/res/numbers.png -------------------------------------------------------------------------------- /res/numbers32.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/drapid/HFS/06a40abe58c47b63bbe60fd63767d33c123d8d44/res/numbers32.png -------------------------------------------------------------------------------- /res/shell.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/drapid/HFS/06a40abe58c47b63bbe60fd63767d33c123d8d44/res/shell.png -------------------------------------------------------------------------------- /runscriptDlg.dfm: -------------------------------------------------------------------------------- 1 | object runScriptFrm: TrunScriptFrm 2 | Left = 0 3 | Top = 0 4 | Caption = 'Run script' 5 | ClientHeight = 312 6 | ClientWidth = 544 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -11 11 | Font.Name = 'Tahoma' 12 | Font.Style = [] 13 | OldCreateOrder = False 14 | PixelsPerInch = 96 15 | TextHeight = 13 16 | object resultBox: TMemo 17 | Left = 0 18 | Top = 41 19 | Width = 544 20 | Height = 271 21 | Align = alClient 22 | Lines.Strings = ( 23 | 'Write your script in the external editor, then click Run.' 24 | 'In this box will see the result of the script you run.') 25 | TabOrder = 0 26 | end 27 | object Panel1: TPanel 28 | Left = 0 29 | Top = 0 30 | Width = 544 31 | Height = 41 32 | Align = alTop 33 | BevelOuter = bvNone 34 | TabOrder = 1 35 | object sizeLbl: TLabel 36 | Left = 503 37 | Top = 24 38 | Width = 32 39 | Height = 13 40 | Alignment = taRightJustify 41 | Caption = 'Size: 0' 42 | end 43 | object runBtn: TButton 44 | Left = 16 45 | Top = 10 46 | Width = 75 47 | Height = 25 48 | Caption = '&Run' 49 | TabOrder = 0 50 | OnClick = runBtnClick 51 | end 52 | object autorunChk: TCheckBox 53 | Left = 104 54 | Top = 16 55 | Width = 169 56 | Height = 17 57 | Caption = '&Auto run at every saving' 58 | Checked = True 59 | State = cbChecked 60 | TabOrder = 1 61 | end 62 | end 63 | end 64 | -------------------------------------------------------------------------------- /runscriptDlg.pas: -------------------------------------------------------------------------------- 1 | unit runscriptDlg; 2 | 3 | interface 4 | 5 | uses 6 | SysUtils, Variants, Classes, Graphics, Controls, Forms, 7 | Dialogs, StdCtrls, ExtCtrls; 8 | 9 | type 10 | TrunScriptFrm = class(TForm) 11 | resultBox: TMemo; 12 | Panel1: TPanel; 13 | runBtn: TButton; 14 | autorunChk: TCheckBox; 15 | sizeLbl: TLabel; 16 | procedure runBtnClick(Sender: TObject); 17 | private 18 | { Private declarations } 19 | public 20 | { Public declarations } 21 | end; 22 | 23 | var 24 | runScriptFrm: TrunScriptFrm; 25 | 26 | implementation 27 | 28 | {$R *.dfm} 29 | 30 | uses 31 | main, srvUtils, srvClassesLib, scriptLib, RDFileUtil; 32 | 33 | procedure TrunScriptFrm.runBtnClick(Sender: TObject); 34 | var 35 | tpl: Ttpl; 36 | begin 37 | tpl := Ttpl.create; 38 | try 39 | try 40 | tpl.fullText := loadFile(tempScriptFilename); 41 | resultBox.text := runScript(mainFrm.fileSrv, tpl[''], NIL, tpl); 42 | sizeLbl.Caption := getTill(':', sizeLbl.Caption)+': '+intToStr(length(resultBox.text)); 43 | except 44 | on e:Exception do 45 | resultBox.text:=e.message 46 | end; 47 | finally 48 | tpl.free 49 | end; 50 | end; 51 | 52 | end. 53 | -------------------------------------------------------------------------------- /srv/hsUtils.pas: -------------------------------------------------------------------------------- 1 | { 2 | Copyright (C) 2002-2020 Massimo Melina (www.rejetto.com) 3 | 4 | This program is free software; you can redistribute it and/or modify 5 | it under the terms of the GNU General Public License as published by 6 | the Free Software Foundation; either version 2 of the License, or 7 | (at your option) any later version. 8 | 9 | This program is distributed in the hope that it will be useful, 10 | but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | GNU General Public License for more details. 13 | 14 | You should have received a copy of the GNU General Public License 15 | along with this program; if not, write to the Free Software 16 | Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 17 | 18 | 19 | HTTP Server Utils 20 | 21 | } 22 | {$I- } 23 | 24 | unit HSUtils; 25 | {$INCLUDE defs.inc } 26 | {$I NoRTTI.inc} 27 | 28 | interface 29 | 30 | uses 31 | classes, messages, 32 | contnrs, strUtils, 33 | types 34 | ; 35 | 36 | 37 | // decode/decode url 38 | function decodeURL(const url: String; utf8: Boolean=TRUE): UnicodeString; OverLoad; 39 | function decodeURL(const url: RawByteString): UnicodeString; OverLoad; 40 | function encodeURL(const url: String; nonascii: Boolean=TRUE; spaces: Boolean=TRUE; 41 | htmlEncoding: Boolean=FALSE):string; OverLoad; 42 | function encodeURL(const url: RawByteString; nonascii: Boolean=TRUE; spaces: Boolean=TRUE; 43 | unicode: boolean=FALSE): RawByteString; OverLoad; 44 | // returns true if address is not suitable for the internet 45 | function isLocalIP(const ip: String): Boolean; 46 | // ensure a string ends with a specific string 47 | procedure includeTrailingString(var s: UnicodeString; const ss: UnicodeString); OverLoad; 48 | procedure includeTrailingString(var s: RawByteString; const ss: RawByteString); OverLoad; 49 | // gets unicode code for specified character 50 | function charToUnicode(c: WideChar): dword; OverLoad; 51 | function charToUnicode(c: AnsiChar): dword; OverLoad; 52 | // this version of pos() is able to skip the pattern if inside quotes 53 | {$IFDEF UNICODE} 54 | function nonQuotedPos(const ss, s: String; ofs: Integer=1; const quote: String='"'; const unquote: String='"'): Integer; OverLoad; 55 | {$ENDIF UNICODE} 56 | function nonQuotedPos(const ss, s: RawByteString; ofs: integer=1; const quote: RawByteString='"'; const unquote: RawByteString='"'): Integer; OverLoad; 57 | // case insensitive version 58 | //function ipos(ss, s:string; ofs:integer=1):integer; overload; 59 | function getNameOf(const s: String): String; OverLoad; // colon included 60 | function getNameOf(const s: RawByteString): RawByteString; OverLoad; // colon included 61 | function namePos(const name: string; const headers:string; from:integer=1):integer; OverLoad; 62 | function namePos(const name: RawByteString; const headers: RawByteString; from: integer=1):integer; OverLoad; 63 | 64 | implementation 65 | 66 | uses 67 | Windows, sysutils, 68 | {$IFDEF UNICODE} 69 | AnsiStrings, 70 | // AnsiClasses, 71 | {$ENDIF UNICODE} 72 | OverbyteIcsWSocket, 73 | RDUtils, 74 | srvConst; 75 | 76 | const 77 | HEADER_LIMITER: RawByteString = CRLFA+CRLFA; 78 | MAX_REQUEST_LENGTH = 64*1024; 79 | MAX_INPUT_BUFFER_LENGTH = 256*1024; 80 | HexCharsW: set of Char = ['0', '1', '2', '3', '4', '5', '6', '7', '8', '9', 'a', 'b', 'c', 'd', 'e', 'f', 81 | 'A', 'B', 'C', 'D', 'E', 'F']; // 82 | procedure includeTrailingString(var s: UnicodeString; const ss: UnicodeString); 83 | begin if copy(s, length(s)-length(ss)+1, length(ss)) <> ss then s:=s+ss end; 84 | 85 | procedure includeTrailingString(var s: RawByteString; const ss: RawByteString); 86 | begin 87 | if copy(s, length(s)-length(ss)+1, length(ss)) <> ss then 88 | s:=s+ss 89 | end; 90 | 91 | function charToUnicode(c: WideChar):dword; 92 | begin stringToWideChar(c,@result,4) end; 93 | 94 | function charToUnicode(c: AnsiChar):dword; 95 | begin stringToWideChar(c,@result,4) end; 96 | 97 | function isLocalIP(const ip:string):boolean; 98 | var 99 | r: record d,c,b,a:byte end; 100 | begin 101 | if ip = '::1' then 102 | exit(TRUE); 103 | if ip = '' then 104 | exit(False); 105 | {$IFDEF FPC} 106 | dword(r) := WSocket_ntohl(WSocket_inet_addr(@ip[1])); 107 | {$ELSE FPC} 108 | dword(r) := dword(WSocket_ntohl(WSocket_inet_addr(ansiString(ip)))); 109 | {$ENDIF FPC} 110 | result:=(r.a in [0,10,23,127]) 111 | or (r.a = 192) and ((r.b = 168) or (r.b = 0) and (r.c = 2)) 112 | or (r.a = 169) and (r.b = 254) 113 | or (r.a = 172) and (r.b in [16..31]) 114 | end; // isLocalIP 115 | 116 | function min(a,b:integer):integer; 117 | begin if a < b then result:=a else result:=b end; 118 | 119 | 120 | 121 | {$IFDEF UNICODE} 122 | function nonQuotedPos(const ss, s: String; ofs: Integer=1; const quote: String='"'; const unquote: String='"'): Integer; OverLoad; 123 | var 124 | qpos: integer; 125 | begin 126 | repeat 127 | result := posEx(ss, s, ofs); 128 | if result = 0 then 129 | exit; 130 | 131 | repeat 132 | qpos := posEx(quote, s, ofs); 133 | if qpos = 0 then 134 | exit; // there's no quoting, our result will fit 135 | if qpos > result then 136 | exit; // the quoting doesn't affect the piece, accept the result 137 | ofs := posEx(unquote, s, qpos+1); 138 | if ofs = 0 then 139 | exit; // it is not closed, we don't consider it quoting 140 | inc(ofs); 141 | until ofs > result; // this quoting was short, let's see if we have another 142 | until false; 143 | end; // nonQuotedPos 144 | {$ENDIF UNICODE} 145 | 146 | function nonQuotedPos(const ss, s: RawByteString; ofs: integer=1; const quote: RawByteString='"'; const unquote: RawByteString='"'):integer; OverLoad; 147 | var 148 | qpos: integer; 149 | begin 150 | repeat 151 | result:=posEx(ss, s, ofs); 152 | if result = 0 then exit; 153 | 154 | repeat 155 | qpos:=posEx(quote, s, ofs); 156 | if qpos = 0 then exit; // there's no quoting, our result will fit 157 | if qpos > result then exit; // the quoting doesn't affect the piece, accept the result 158 | ofs:=posEx(unquote, s, qpos+1); 159 | if ofs = 0 then exit; // it is not closed, we don't consider it quoting 160 | inc(ofs); 161 | until ofs > result; // this quoting was short, let's see if we have another 162 | until false; 163 | end; // nonQuotedPos 164 | 165 | function decodeURL(const url: string; utf8: boolean=TRUE): UnicodeString; 166 | var 167 | i, l: integer; 168 | c: char; 169 | resA: RawByteString; 170 | ca: AnsiChar; 171 | c1, c2: Char; 172 | hv: Boolean; 173 | begin 174 | setLength(result, length(url)); 175 | if length(url) = 0 then 176 | Exit; 177 | setLength(resA, length(url)); 178 | l := 0; 179 | i := 1; 180 | while i<=length(url) do 181 | begin 182 | hv := False; 183 | if (url[i] = '%') and (i+2 <= length(url)) then 184 | begin 185 | c1 := url[i+1]; 186 | c2 := url[i+2]; 187 | if (c1 in HexCharsW) and 188 | (c2 in HexCharsW) then 189 | try 190 | if utf8 then 191 | ca := AnsiChar(strToInt( '$'+c1+c2 )) 192 | else 193 | c := char(strToInt( '$'+c1+c2 )); 194 | inc(i,2); // three chars for one 195 | hv := True; 196 | except 197 | hv := False; 198 | end; 199 | end; 200 | 201 | if not hv then 202 | if utf8 then 203 | ca := AnsiChar(url[i]) 204 | else 205 | c := url[i]; 206 | 207 | inc(i); 208 | inc(l); 209 | if utf8 then 210 | resA[l] := ca 211 | else 212 | result[l] := c; 213 | end; 214 | if utf8 then 215 | begin 216 | setLength(resA, l); 217 | Result := UnUTF(resA); 218 | end 219 | else 220 | setLength(result, l); 221 | end; // decodeURL 222 | 223 | function decodeURL(const url: RawByteString): UnicodeString; 224 | var 225 | i, l: integer; 226 | resA: RawByteString; 227 | c: AnsiChar; 228 | begin 229 | setLength(result, length(url)); 230 | setLength(resA, length(url)); 231 | l := 0; 232 | i := 1; 233 | while i<=length(url) do 234 | begin 235 | if (url[i] = '%') and (i+2 <= length(url)) then 236 | try 237 | c := AnsiChar(strToIntA(RawByteString('$')+url[i+1]+url[i+2] )); 238 | inc(i,2); // three chars for one 239 | except 240 | c := url[i]; 241 | end 242 | else 243 | c := url[i]; 244 | 245 | inc(i); 246 | inc(l); 247 | resA[l] := c; 248 | end; 249 | setLength(resA, l); 250 | Result := UnUTF(resA); 251 | end; // decodeURL 252 | 253 | 254 | function encodeURL(const url:string; nonascii:boolean=TRUE; spaces:boolean=TRUE; 255 | htmlEncoding:boolean=FALSE):string; 256 | var 257 | i: integer; 258 | encodePerc, encodeHTML: TcharSetW; 259 | encodePercA: TcharSetA; 260 | a: RawByteString; 261 | begin 262 | result:=''; 263 | if url = '' then 264 | exit; 265 | encodeHTML:=[]; 266 | encodePercA := []; 267 | if nonascii then 268 | encodePercA:=[#0..#31,'#','%','?','"','''','&','<','>',':'] + [#128..#255]; 269 | encodePerc:=[#0..#31,'#','%','?','"','''','&','<','>',':']; 270 | // actually ':' needs encoding only in relative url 271 | if spaces then include(encodePerc,' '); 272 | if not htmlEncoding then 273 | begin 274 | encodePerc:=encodePerc+encodeHTML; 275 | encodeHTML:=[]; 276 | end; 277 | if nonascii then 278 | begin 279 | a:=UTF8encode(url); // couldn't find a better way to force url to have the UTF8 encoding 280 | for i:=1 to length(a) do 281 | if a[i] in encodePercA then 282 | result:=result+'%'+intToHex(ord(a[i]),2) 283 | else if a[i] in encodeHTML then 284 | result:=result+'&#'+intToStr(charToUnicode(a[i]))+';' 285 | else 286 | result:=result+a[i]; 287 | end 288 | else 289 | for i:=1 to length(url) do 290 | if url[i] in encodePerc then 291 | result:=result+'%'+intToHex(ord(url[i]),2) 292 | else if url[i] in encodeHTML then 293 | result:=result+'&#'+intToStr(charToUnicode(url[i]))+';' 294 | else 295 | result:=result+url[i]; 296 | end; // encodeURL 297 | 298 | function encodeURL(const url: RawByteString; nonascii:boolean=TRUE; spaces:boolean=TRUE; 299 | unicode:boolean=FALSE): RawByteString; 300 | var 301 | i: integer; 302 | encodePerc, encodeUni: set of AnsiChar; 303 | begin 304 | result := ''; 305 | encodeUni := []; 306 | if nonascii then 307 | encodeUni:=[#128..#255]; 308 | encodePerc := [#0..#31,'#','%','?','"','''','&','<','>',':']; 309 | // actually ':' needs encoding only in relative url 310 | if spaces then 311 | include(encodePerc,' '); 312 | if not unicode then 313 | begin 314 | encodePerc:=encodePerc+encodeUni; 315 | encodeUni:=[]; 316 | end; 317 | for i:=1 to length(url) do 318 | if url[i] in encodePerc then 319 | result := result+'%'+IntToHexA(ord(url[i]),2) 320 | else if url[i] in encodeUni then 321 | result := result+'&#'+IntToStrA(Byte(url[i]))+';' 322 | else 323 | result := result+url[i]; 324 | end; // encodeURL 325 | 326 | function replyHeader_IntPositive(const name: String; int: Int64): String; 327 | begin 328 | result := ''; 329 | if int >= 0 then 330 | result := name+': '+intToStr(int)+CRLF; 331 | end; 332 | 333 | { 334 | function replyHeader_Str(const name:string; const str:string):string; 335 | begin 336 | result:=''; 337 | if str > '' then result:=name+': '+str+CRLF; 338 | end; 339 | } 340 | function replyHeader_Str(const name:RawByteString; const str:RawByteString): RawByteString; OverLoad; 341 | begin 342 | result:=''; 343 | if str > '' then result:=name+': '+str+CRLFA; 344 | end; 345 | 346 | function replyHeader_Str(const name:RawByteString; const str:String): RawByteString; OverLoad; 347 | begin 348 | result:=''; 349 | if str > '' then result:=name+': '+ StrToUTF8(str)+CRLFA; 350 | end; 351 | 352 | function getNameOf(const s:string):string; // colon included 353 | begin result:=copy(s, 1, pos(':', s)) end; 354 | 355 | function getNameOf(const s: RawByteString): RawByteString; // colon included 356 | begin result:=copy(s, 1, pos(RawByteString(':'), s)) end; 357 | 358 | // return 0 if not found 359 | function namePos(const name:string; const headers:string; from:integer=1):integer; 360 | begin 361 | result:=from; 362 | repeat 363 | result:=ipos(name, headers, result); 364 | until (result<=1) // both not found and found at the start of the string 365 | or (headers[result-1] = #10) // or start of the line 366 | end; // namePos 367 | 368 | function namePos(const name: RawByteString; const headers: RawByteString; from: integer=1):integer; OverLoad; 369 | begin 370 | result := from; 371 | repeat 372 | result := ipos(name, headers, result); 373 | until (result<=1) // both not found and found at the start of the string 374 | or (headers[result-1] = #10) // or start of the line 375 | end; // namePos 376 | 377 | end. 378 | -------------------------------------------------------------------------------- /srv/netUtils.pas: -------------------------------------------------------------------------------- 1 | {$INCLUDE defs.inc } 2 | unit netUtils; 3 | {$I NoRTTI.inc} 4 | 5 | interface 6 | 7 | uses 8 | Classes, Windows, 9 | OverbyteIcshttpProt, 10 | {$IFNDEF FPC} 11 | OverbyteIcsUtils, 12 | OverbyteIcsTypes, 13 | {$ENDIF FPC} 14 | Types, 15 | srvClassesLib; 16 | 17 | type 18 | TProgressFunc = function(p: real): Boolean of object; 19 | 20 | function httpGetStr(const url: string; from: int64=0; size: int64=-1): string; 21 | function httpGet(const url:string; from:int64=0; size:int64=-1): RawByteString; 22 | // function httpGetFile1(const url, filename: string; var errMsg: String; notify: TdocDataEvent=NIL): Boolean; 23 | // function httpGetFileWithCheck1(const url, filename: string; var errMsg: String; notify: TdocDataEvent=NIL): Boolean; 24 | function httpGetFile(const url, filename: string; var errMsg: String; notify: TProgressFunc=NIL): Boolean; 25 | function httpGetFileWithCheck(const url, filename: string; var errMsg: String; notify: TProgressFunc=NIL): Boolean; 26 | 27 | function httpFileSize(const url: string): int64; 28 | function getIPs(): TStringDynArray; 29 | function getLocalIPs({$IFDEF USE_IPv6}const ASocketFamily: TSocketFamily = sfIPv4 {$ENDIF USE_IPv6}): TStringDynArray; 30 | function findRedirection(var h, p: String; const agent: String): Boolean; 31 | function checkHTTPSCanWork(var missing: TStringDynArray): Boolean; OverLoad; 32 | function checkHTTPSCanWork(): Boolean; OverLoad; 33 | function getExternalAddress(var res: String; provider: PString=NIL; doLogFunc: TAdd2LogEvent = NIL): Boolean; 34 | // an ip address where we are listening 35 | function getIP(): String; 36 | 37 | {$IFDEF USE_IPv6} 38 | const 39 | sfIPv4 = TSocketFamily.sfIPv4; 40 | sfIPv6 = TSocketFamily.sfIPv6; 41 | sfAny = TSocketFamily.sfAny; 42 | {$ENDIF USE_IPv6} 43 | 44 | type 45 | TBoolFunc = function(): Boolean; 46 | 47 | {$IFDEF USE_IPv6} 48 | ThttpClient = class(TSslHttpCli) 49 | {$ELSE not USE_IPv6} 50 | ThttpClient = class(THttpCli) 51 | {$ENDIF USE_IPv6} 52 | private 53 | fCanHTTPS: TBoolFunc; 54 | fAgent: String; 55 | fOnProgress: TProgressFunc; 56 | constructor Create(AOwner: TComponent); override; 57 | procedure onHttpGetUpdate(sender: TObject; buffer: Pointer; len: Integer); 58 | public 59 | destructor Destroy; OverRide; 60 | class function createURL(const url: String; canHTTPS: TBoolFunc): ThttpClient; 61 | end; 62 | var 63 | autoDownloadLibs: TBoolFunc; 64 | 65 | implementation 66 | 67 | uses 68 | sysutils, StrUtils, 69 | RDUtils, RDFileUtil, RnQCrypt, 70 | OverbyteIcsWSocket, 71 | {$IFNDEF FPC} 72 | {$IFDEF USE_SSL} 73 | OverbyteIcsSslBase, 74 | OverbyteIcsSSLEAY, 75 | {$ENDIF USE_SSL} 76 | {$ENDIF ~FPC} 77 | srvConst, srvUtils, srvVars, 78 | HSUtils; 79 | 80 | resourcestring 81 | unsignesErr = 'Signature is not valid'; 82 | 83 | function httpGetStr(const url: String; from:int64=0; size:int64=-1): String; 84 | var 85 | reply: Tstringstream; 86 | begin 87 | if size = 0 then 88 | exit(''); 89 | reply := TStringStream.Create(''); 90 | with ThttpClient.createURL(url, autoDownloadLibs) do 91 | try 92 | rcvdStream := reply; 93 | if (from <> 0) or (size > 0) then 94 | contentRangeBegin := intToStr(from); 95 | if size > 0 then 96 | contentRangeEnd := intToStr(from+size-1); 97 | get(); 98 | result := reply.dataString; 99 | if sameText('utf-8', reGet(ContentType, '; *charset=(.+) *($|;)')) then 100 | Result:=UTF8ToString(result); 101 | finally 102 | reply.free; 103 | Free; 104 | end 105 | end; // httpGetStr 106 | 107 | function httpGet(const url: string; from: int64=0; size: int64=-1): RawByteString; 108 | var 109 | fs: TMemoryStream; 110 | httpCli: ThttpClient; 111 | begin 112 | if size = 0 then 113 | begin 114 | result:=''; 115 | exit; 116 | end; 117 | 118 | // Result := LoadFromURLStr(url, from, size); 119 | fs := nil; 120 | Result := ''; 121 | httpCli := ThttpClient.createURL(url, autoDownloadLibs); 122 | if Assigned(httpCli) then 123 | with httpCli do 124 | try 125 | fs := TMemoryStream.Create; 126 | rcvdStream := fs; 127 | if (from <> 0) or (size > 0) then 128 | contentRangeBegin := intToStr(from); 129 | if size > 0 then 130 | contentRangeEnd := intToStr(from+size-1); 131 | 132 | if size >= 0 then 133 | begin 134 | httpCli.Head; 135 | if httpCli.ContentLength < from then 136 | Exit; 137 | end; 138 | 139 | get(); 140 | if fs.Size > 0 then 141 | begin 142 | SetLength(Result, fs.Size); 143 | fs.Seek(0, soFromBeginning); 144 | fs.Read(Result[1], Length(Result)); 145 | end; 146 | finally 147 | fs.free; 148 | Free; 149 | end 150 | 151 | 152 | end; // httpGet 153 | 154 | function httpFileSize(const url: string): int64; 155 | var 156 | httpCli: ThttpClient; 157 | begin 158 | Result := -1; 159 | httpCli := ThttpClient.createURL(url, autoDownloadLibs); 160 | if Assigned(httpCli) then 161 | with httpCli do 162 | try 163 | try 164 | head(); 165 | result := contentLength 166 | except result:=-1 167 | end; 168 | finally free 169 | end; 170 | end; // httpFileSize 171 | 172 | function httpGetFile1(const url, filename: string; var errMsg: String; notify: TdocDataEvent=NIL): Boolean; 173 | var 174 | httpCli: ThttpClient; 175 | supposed: int64; 176 | reply: Tfilestream; 177 | begin 178 | supposed := 0; 179 | httpCli := ThttpClient.createURL(url, autoDownloadLibs); 180 | if Assigned(httpCli) then 181 | with httpCli do 182 | try 183 | reply := NIL; 184 | reply := TfileStream.Create(filename, fmCreate); 185 | rcvdStream := reply; 186 | onDocData := notify; 187 | result := TRUE; 188 | try 189 | get() 190 | except 191 | result := FALSE; 192 | errMsg := ReasonPhrase; 193 | end; 194 | supposed := ContentLength; 195 | finally 196 | if Assigned(reply) then 197 | reply.free; 198 | free; 199 | end; 200 | result := result and (sizeOfFile(filename)=supposed); 201 | if not result then 202 | deleteFile(filename); 203 | end; // httpGetFile 204 | 205 | function httpGetFile(const url, filename: string; var errMsg: String; notify: TProgressFunc=NIL): Boolean; 206 | var 207 | httpCli: ThttpClient; 208 | supposed: int64; 209 | reply: Tfilestream; 210 | begin 211 | supposed := 0; 212 | httpCli := ThttpClient.createURL(url, autoDownloadLibs); 213 | if Assigned(httpCli) then 214 | with httpCli do 215 | try 216 | reply := NIL; 217 | reply := TfileStream.Create(filename, fmCreate); 218 | rcvdStream := reply; 219 | fOnProgress := notify; 220 | onDocData := httpCli.onHttpGetUpdate; 221 | result := TRUE; 222 | try 223 | get() 224 | except 225 | result := FALSE; 226 | errMsg := ReasonPhrase; 227 | end; 228 | supposed := ContentLength; 229 | finally 230 | if Assigned(reply) then 231 | reply.free; 232 | free; 233 | end; 234 | result := result and (sizeOfFile(filename)=supposed); 235 | if not result then 236 | deleteFile(filename); 237 | end; // httpGetFile 238 | 239 | function httpGetRaw(const url: string; maxSize: Int64; var ResultRaw: RawByteString; var errMsg: String; notify: TdocDataEvent=NIL): Boolean; 240 | var 241 | httpCli: ThttpClient; 242 | supposed: int64; 243 | reply: TMemoryStream; 244 | begin 245 | supposed := 0; 246 | ResultRaw := ''; 247 | httpCli := ThttpClient.createURL(url, autoDownloadLibs); 248 | if Assigned(httpCli) then 249 | with httpCli do 250 | try 251 | reply := TMemoryStream.Create; 252 | rcvdStream := reply; 253 | onDocData := notify; 254 | result := TRUE; 255 | try 256 | get() 257 | except 258 | result := FALSE; 259 | errMsg := ReasonPhrase; 260 | end; 261 | supposed := ContentLength; 262 | if result then 263 | begin 264 | SetLength(ResultRaw, reply.Size); 265 | if reply.Size > 0 then 266 | CopyMemory(@ResultRaw[1], reply.Memory, reply.Size); 267 | end; 268 | finally 269 | if Assigned(reply) then 270 | reply.free; 271 | free; 272 | end; 273 | result := result and (Length(ResultRaw)=supposed); 274 | if not result then 275 | ResultRaw := ''; 276 | end; // httpGetRaw 277 | 278 | 279 | function httpGetFileWithCheck(const url, filename: string; var errMsg: String; notify: TProgressFunc=NIL): Boolean; 280 | const 281 | sigFileExt = '.sig'; 282 | // tmpSubFolder = 'tmp.download'; 283 | var 284 | // tmpFolder: String; 285 | tmpFile: String; 286 | resultFile: String; 287 | pubKey: RawByteString; 288 | sign64: RawByteString; 289 | begin 290 | // tmpFolder := ExtractFileDir(filename) + tmpSubFolder + PathDelim; 291 | resultFile := ExtractFileName(filename); 292 | tmpFile := filename + '.downloading'; 293 | 294 | // if not DirectoryExists(tmpFolder, false) then 295 | // CreateDirRecursive(tmpFolder); 296 | 297 | Result := httpGetFile(url, tmpFile, errMsg, notify); 298 | if Result then 299 | begin 300 | Result := httpGetRaw(url + sigFileExt, 5555, sign64, errMsg); 301 | end; 302 | if Result then 303 | begin 304 | pubKey := getRes('RDpubkey'); 305 | Result := verifyEccSignFile(tmpFile, sign64, pubKey); 306 | if not Result then 307 | errMsg := unsignesErr; 308 | end; 309 | if not result then 310 | begin 311 | if FileExists(tmpFile, false) then 312 | begin 313 | deleteFile(tmpFile); 314 | if FileExists(tmpFile + sigFileExt, false) then 315 | deleteFile(tmpFile + sigFileExt); 316 | end; 317 | end 318 | else 319 | begin 320 | MoveFile(PChar(tmpFile), PChar(filename)); 321 | end; 322 | end; // httpGetFileWithCheck 323 | 324 | function httpGetFileWithCheck1(const url, filename: string; var errMsg: String; notify: TdocDataEvent=NIL): Boolean; 325 | const 326 | sigFileExt = '.sig'; 327 | // tmpSubFolder = 'tmp.download'; 328 | var 329 | // tmpFolder: String; 330 | tmpFile: String; 331 | resultFile: String; 332 | pubKey: RawByteString; 333 | sign64: RawByteString; 334 | begin 335 | // tmpFolder := ExtractFileDir(filename) + tmpSubFolder + PathDelim; 336 | resultFile := ExtractFileName(filename); 337 | tmpFile := filename + '.downloading'; 338 | 339 | // if not DirectoryExists(tmpFolder, false) then 340 | // CreateDirRecursive(tmpFolder); 341 | 342 | Result := httpGetFile1(url, tmpFile, errMsg, notify); 343 | if Result then 344 | begin 345 | Result := httpGetRaw(url + sigFileExt, 5555, sign64, errMsg); 346 | end; 347 | if Result then 348 | begin 349 | pubKey := getRes('RDpubkey'); 350 | Result := verifyEccSignFile(tmpFile, sign64, pubKey); 351 | if not Result then 352 | errMsg := unsignesErr; 353 | end; 354 | if not result then 355 | begin 356 | if FileExists(tmpFile, false) then 357 | begin 358 | deleteFile(tmpFile); 359 | if FileExists(tmpFile + sigFileExt, false) then 360 | deleteFile(tmpFile + sigFileExt); 361 | end; 362 | end 363 | else 364 | begin 365 | MoveFile(PChar(tmpFile), PChar(filename)); 366 | end; 367 | end; // httpGetFileWithCheck 368 | 369 | function getIPs(): TStringDynArray; 370 | {$IFDEF USE_IPv6} 371 | var 372 | a6: TStringDynArray; 373 | I: Integer; 374 | {$ENDIF USE_IPv6} 375 | begin 376 | try 377 | {$IFDEF USE_IPv6} 378 | result := listToArray(localIPlist(sfIPv4)); 379 | a6 := listToArray(localIPlist(sfIPv6)); 380 | if Length(a6) > 0 then 381 | begin 382 | for I := Low(a6) to High(a6) do 383 | a6[i] := '[' + a6[i] + ']'; 384 | Result := Result + a6; 385 | end; 386 | {$ELSE USE_IPv6} 387 | result := listToArray(localIPlist); 388 | {$ENDIF USE_IPv6} 389 | except 390 | result := NIL 391 | end; 392 | end; 393 | 394 | function getLocalIPs({$IFDEF USE_IPv6}const ASocketFamily: TSocketFamily = sfIPv4 {$ENDIF USE_IPv6}): TStringDynArray; 395 | begin 396 | result := listToArray(localIPlist({$IFDEF USE_IPv6}ASocketFamily{$ENDIF USE_IPv6})); 397 | end; 398 | 399 | function getIP(): String; 400 | var 401 | i: integer; 402 | ips: Tstrings; 403 | begin 404 | ips := LocalIPlist(); 405 | case ips.count of 406 | 0: result := ''; 407 | 1: result := ips[0]; 408 | else 409 | i:=0; 410 | while (i < ips.count-1) and isLocalIP(ips[i]) do 411 | inc(i); 412 | result := ips[i]; 413 | end; 414 | end; // getIP 415 | 416 | 417 | function findRedirection(var h, p: String; const agent: String): Boolean; 418 | var 419 | http: THttpCli; 420 | begin 421 | result := FALSE; 422 | http := Thttpcli.create(NIL); 423 | try 424 | http.url := h; 425 | http.agent := agent; //HFS_HTTP_AGENT; 426 | try 427 | http.get() 428 | except // a redirection will result in an exception 429 | if (http.statusCode < 300) or (http.statusCode >= 400) then 430 | exit; 431 | result := TRUE; 432 | h := http.hostname; 433 | p := http.ctrlSocket.Port; 434 | end; 435 | finally 436 | http.free 437 | end 438 | end; 439 | 440 | function checkHTTPSCanWork(var missing: TStringDynArray): Boolean; 441 | {$IFDEF USE_SSL} 442 | var 443 | files: array of string; // = ['libcrypto-1_1.dll','libssl-1_1.dll']; 444 | // missing: TStringDynArray; 445 | {$ENDIF ~USE_SSL} 446 | begin 447 | {$IFDEF USE_SSL} 448 | missing := NIL; 449 | // m := NIL; 450 | SetLength(files, 2); 451 | files[0] := GLIBEAY_300DLL_Name; 452 | files[1] := GSSLEAY_300DLL_Name; 453 | for var s in files do 454 | if not FileExists(s) and not dllIsPresent(s) then 455 | addString(s, missing); 456 | if missing=NIL then 457 | exit(TRUE); 458 | {$ENDIF USE_SSL} 459 | // m := missing; 460 | Result := False; 461 | end; 462 | 463 | function checkHTTPSCanWork(): Boolean; OverLoad; 464 | var 465 | m: TStringDynArray; 466 | begin 467 | Result := checkHTTPSCanWork(m); 468 | end; 469 | 470 | 471 | class function ThttpClient.createURL(const url: String; canHTTPS: TBoolFunc): ThttpClient; 472 | begin 473 | if startsText('https://', url) 474 | and not (Assigned(CanHTTPS) and canHTTPS()) then 475 | exit(NIL); 476 | result := ThttpClient.Create(NIL); 477 | result.URL := url; 478 | result.fCanHTTPS := canHTTPS; 479 | result.fAgent := HFS_HTTP_AGENT; 480 | result.Agent := HFS_HTTP_AGENT; 481 | {$IFDEF USE_SSL} 482 | if checkHTTPSCanWork() then 483 | result.SslContext := TSslContext.Create(NIL) 484 | else 485 | begin 486 | result.followRelocation := False; 487 | result.SslContext := NIL; 488 | result.CtrlSocket.SslEnable := False; 489 | end; 490 | {$ENDIF USE_SSL} 491 | end; 492 | 493 | constructor ThttpClient.create(AOwner: TComponent); 494 | begin 495 | inherited; 496 | {$IFDEF USE_SSL} 497 | followRelocation := TRUE; 498 | {$ENDIF USE_SSL} 499 | end; // create 500 | 501 | destructor ThttpClient.Destroy; 502 | begin 503 | {$IFDEF USE_SSL} 504 | if Assigned(SslContext) then 505 | SslContext.free; 506 | SslContext:=NIl; 507 | {$ENDIF USE_SSL} 508 | inherited destroy; 509 | end; 510 | 511 | procedure ThttpClient.onHttpGetUpdate(sender: TObject; buffer: Pointer; len: integer); 512 | var 513 | prg: Real; 514 | begin 515 | if Assigned(fOnProgress) then 516 | with sender as ThttpCli do 517 | begin 518 | prg := safeDiv(0.0+RcvdCount, contentLength); 519 | if not fOnProgress(prg) then 520 | abort(); 521 | end; 522 | end; // onHttpGetUpdate 523 | 524 | //function getExternalAddress(var res: String; provider: PString=NIL; doLog: Boolean = false): Boolean; 525 | function getExternalAddress(var res: String; provider: PString=NIL; doLogFunc: TAdd2LogEvent = NIL): Boolean; 526 | 527 | procedure loadIPservices(src: String=''); 528 | var 529 | l:string; 530 | sA: RawByteString; 531 | begin 532 | if src = '' then 533 | begin 534 | if now()-IPservicesTime < 1 then exit; // once a day 535 | IPservicesTime:=now(); 536 | try 537 | sA := trim(httpGet(IP_SERVICES_URL)); 538 | except 539 | exit 540 | end; 541 | src := (UnUTF(sA)); 542 | end; 543 | IPservices := NIL; 544 | while src > '' do 545 | begin 546 | l := chopLine(src); 547 | if ansiStartsText('http://', l) then 548 | addString(l, IPservices); 549 | end; 550 | end; // loadIPservices 551 | 552 | const {$J+} 553 | lastProvider: string = ''; // this acts as a static variable 554 | var 555 | s, mark, addr: string; 556 | sA: RawByteString; 557 | i: integer; 558 | begin 559 | result := FALSE; 560 | if customIPservice > '' then 561 | s := customIPservice 562 | else 563 | begin 564 | loadIPservices(); 565 | if IPservices = NIL then 566 | loadIPservices(UnUTF(getRes('IPservices'))); 567 | if IPservices = NIL then 568 | exit; 569 | 570 | repeat 571 | s := IPservices[random(length(IPservices))]; 572 | until s <> lastProvider; 573 | lastProvider:=s; 574 | end; 575 | addr := chop('|', s); 576 | if assigned(provider) then 577 | provider^ := addr; 578 | mark := s; 579 | try 580 | sA := httpGet(addr); 581 | s := UnUTF(sA); 582 | except 583 | exit 584 | end; 585 | if mark > '' then 586 | chop(mark, s); 587 | s := trim(s); 588 | if s = '' then 589 | exit; 590 | // try to determine length 591 | i := 1; 592 | while (i < length(s)) and (i < 15) and (s[i+1] in ['0'..'9','.']) do 593 | inc(i); 594 | while (i > 0) and (s[i] = '.') do 595 | dec(i); 596 | setLength(s,i); 597 | result := checkAddressSyntax(s, false) and not isLocalIP(s); 598 | if not result then 599 | exit; 600 | if (res <> s) and Assigned(doLogFunc) then //mainFrm.logOtherEventsChk.checked then 601 | doLogFunc('New external address: '+s+' via '+hostFromURL(addr)); 602 | res := s; 603 | end; // getExternalAddress 604 | 605 | 606 | initialization 607 | autoDownloadLibs := NIL; 608 | end. 609 | -------------------------------------------------------------------------------- /srv/parserLib.pas: -------------------------------------------------------------------------------- 1 | unit parserLib; 2 | {$INCLUDE defs.inc } 3 | {$I NoRTTI.inc} 4 | 5 | interface 6 | 7 | uses 8 | strutils, sysutils, classes, types, windows, 9 | srvClassesLib, 10 | serverLib; 11 | 12 | type 13 | 14 | 15 | // TPars = TStringList; 16 | TPars = TPars2; 17 | 18 | EtplError = class(Exception) 19 | pos, row, col: integer; 20 | code: string; 21 | constructor Create(const msg, code: String; row, col: Integer); 22 | end; 23 | 24 | 25 | const 26 | MARKER_OPEN = UnicodeString('{.'); 27 | MARKER_CLOSE = UnicodeString('.}'); 28 | MARKER_SEP = UnicodeString('|'); 29 | MARKER_QUOTE = UnicodeString('{:'); 30 | MARKER_UNQUOTE = UnicodeString(':}'); 31 | MARKERS: array [0..4] of UnicodeString = ( MARKER_OPEN, MARKER_CLOSE, MARKER_SEP, MARKER_QUOTE, MARKER_UNQUOTE ); 32 | ID2TAG_1Chars = [WideChar('{'), '.', ':']; 33 | 34 | AMARKER_OPEN = RawByteString('{.'); 35 | AMARKER_CLOSE = RawByteString('.}'); 36 | AMARKER_SEP = RawByteString('|'); 37 | AMARKER_QUOTE = RawByteString('{:'); 38 | AMARKER_UNQUOTE = RawByteString(':}'); 39 | AMARKERS: array [0..4] of RawByteString = ( MARKER_OPEN, MARKER_CLOSE, MARKER_SEP, MARKER_QUOTE, MARKER_UNQUOTE ); 40 | 41 | function isAnyMacroIn(const s: RawByteString): Boolean; inline; 42 | function anyMacroMarkerIn(const s: String): Boolean; 43 | function findMacroMarker(const s: string; ofs:integer=1): integer; 44 | procedure applyMacrosAndSymbols(fs: TFileServer; var txt: UnicodeString; cb: TmacroCB; cbData: PMacroData; removeQuotings: Boolean=TRUE); 45 | 46 | function macroQuote(s: UnicodeString): UnicodeString; 47 | function macroDequote(s: UnicodeString): UnicodeString; OverLoad; 48 | {$IFNDEF UNICODE} 49 | function macroDequote(s: String): String; OverLoad; 50 | {$ENDIF UNICODE} 51 | function validUsername(const s: String; acceptEmpty: Boolean=FALSE): Boolean; 52 | 53 | implementation 54 | uses 55 | srvUtils, HSUtils; 56 | 57 | const 58 | MAX_RECUR_LEVEL = 50; 59 | type 60 | TparserIdsStack = array [1..MAX_RECUR_LEVEL] of UnicodeString; 61 | 62 | constructor EtplError.create(const msg, code: String; row, col: Integer); 63 | begin 64 | inherited create(msg); 65 | self.row := row; 66 | self.col := col; 67 | self.code := code; 68 | end; 69 | 70 | procedure applyMacrosAndSymbols2(fs: TFileServer; var pTxt: UnicodeString; cb: TmacroCB; cbData: Pointer; var idsStack: TparserIdsStack; recurLevel: integer=0); 71 | const 72 | // we don't track SEPs, they are handled just before the callback 73 | QUOTE_ID = 0; // QUOTE must come before OPEN because it is a substring 74 | UNQUOTE_ID = 1; 75 | OPEN_ID = 2; 76 | CLOSE_ID = 3; 77 | MAX_MARKER_ID = 3; 78 | {$IFDEF FPC} 79 | function alreadyRecurredOn(const s: UnicodeString): Boolean; OverLoad; 80 | var 81 | i: integer; 82 | begin 83 | //result := TRUE; 84 | if recurLevel > 1 then 85 | for i:=recurLevel downto 1 do 86 | if UnicodeSameText(s, idsStack[i]) then 87 | exit(True); 88 | result:=FALSE; 89 | end; // alreadyRecurredOn 90 | {$ENDIF FPC} 91 | 92 | function alreadyRecurredOn(const s: String): Boolean; OverLoad; 93 | var 94 | i: integer; 95 | begin 96 | //result := TRUE; 97 | if recurLevel > 1 then 98 | for i:=recurLevel downto 1 do 99 | if sameText(s, idsStack[i]) then 100 | exit(True); 101 | result:=FALSE; 102 | end; // alreadyRecurredOn 103 | 104 | procedure handleSymbols(); 105 | var 106 | b, e, l : integer; 107 | s, newS: UnicodeString; 108 | begin 109 | e := 0; 110 | l := length(pTxt); 111 | while e < l do 112 | begin 113 | // search for next symbol 114 | b := posEx(UnicodeString('%'), pTxt, e+1); 115 | if b = 0 then 116 | break; 117 | e := b+1; 118 | if pTxt[e] = '%' then 119 | begin // we don't accept %% as a symbol. so, restart parsing from the second % 120 | e := b; 121 | continue; 122 | end; 123 | if not (pTxt[e] in ['_','a'..'z','A'..'Z']) then 124 | continue; // first valid character 125 | while (e < l) and (pTxt[e] in ['0'..'9','a'..'z','A'..'Z','-','_']) do 126 | inc(e); 127 | if pTxt[e] <> '%' then 128 | continue; 129 | // found! 130 | s := substr(pTxt, b, e); 131 | if alreadyRecurredOn(s) then 132 | continue; // the user probably didn't meant to create an infinite loop 133 | 134 | newS := cb(fs, s, NIL, cbData); 135 | if s = newS then 136 | continue; 137 | 138 | idsStack[recurLevel] := s; // keep track of what we recur on 139 | // apply translation, and eventually recur 140 | try 141 | applyMacrosAndSymbols2(fs, newS, cb, cbData, idsStack, recurLevel); 142 | except 143 | end; 144 | idsStack[recurLevel] := ''; 145 | inc(e, replace(pTxt, newS, b, e)); 146 | l := length(pTxt); 147 | end; 148 | end; // handleSymbols 149 | 150 | procedure handleMacros(); 151 | var 152 | pars: TPars; 153 | 154 | function expand(from, to_: Integer): Integer; 155 | var 156 | s, eFullMacro: UnicodeString; 157 | i, o, q, u: integer; 158 | begin 159 | result:=0; 160 | eFullMacro := substr(pTxt, from+length(MARKER_OPEN), to_-length(MARKER_CLOSE)); 161 | if alreadyRecurredOn(eFullMacro) then 162 | exit; // the user probably didn't meant to create an infinite loop 163 | 164 | // let's find the SEPs to build 'pars' 165 | pars.clear(); 166 | i := 1; // char pointer from where we shall copy the macro parameter 167 | o := 0; 168 | q := posEx(MARKER_QUOTE, eFullMacro); // q points to _QUOTE 169 | repeat 170 | o := posEx(MARKER_SEP, eFullMacro, o+1); 171 | if o = 0 then 172 | break; 173 | if (q > 0) and (q < o) then // this SEP is possibly quoted 174 | begin 175 | // update 'q' and 'u' 176 | repeat 177 | u := posEx(MARKER_UNQUOTE, eFullMacro, q); 178 | if u = 0 then 179 | exit; // macro quoting not properly closed 180 | q:=posEx(MARKER_QUOTE, eFullMacro, q+1); // update q for next cycle 181 | // if we find other _QUOTEs before _UNQUOTE, then they are stacked, and we must go through the same number of both markers 182 | while (q > 0) and (q < u) do 183 | begin 184 | u := posEx(MARKER_UNQUOTE, eFullMacro, u+1); 185 | if u = 0 then 186 | exit; // macro quoting not properly closed 187 | q := posEx(MARKER_QUOTE, eFullMacro, q+1); 188 | end; 189 | until (q = 0) or (o < q); 190 | // eventually skip this chunk of string 191 | if o < u then 192 | begin // yes, this SEP is quoted 193 | o:=u; 194 | continue; 195 | end; 196 | end; 197 | // ok, that's a valid SEP, so we collect this as a parameter 198 | pars.add(substr(eFullMacro, i, o-1)); 199 | i:=o+length(MARKER_SEP); 200 | until false; 201 | pars.add(substr(eFullMacro, i, length(eFullMacro))); // last piece 202 | // ok, 'pars' has now been built 203 | 204 | // do the call, recur, and replace with the result 205 | s := cb(fs, eFullMacro, pars, cbData); 206 | idsStack[recurLevel] := eFullMacro; // keep track of what we recur on 207 | if s > '' then 208 | try 209 | try 210 | applyMacrosAndSymbols2(fs, s, cb, cbData, idsStack, recurLevel) 211 | except 212 | end; 213 | finally 214 | idsStack[recurLevel]:='' 215 | end; 216 | result := replace(pTxt, s, from, to_); 217 | end; // expand 218 | 219 | const 220 | ID2TAG: array [0..MAX_MARKER_ID] of string = (MARKER_QUOTE, MARKER_UNQUOTE, MARKER_OPEN, MARKER_CLOSE); 221 | ID2TAGU: array [0..MAX_MARKER_ID] of UnicodeString = (MARKER_QUOTE, MARKER_UNQUOTE, MARKER_OPEN, MARKER_CLOSE); 222 | type 223 | TstackItem = record 224 | pos: integer; 225 | row, col: word; 226 | quote: boolean; 227 | end; 228 | var 229 | i, lastNL, row, m, t: integer; 230 | stack: array of TstackItem; 231 | Nstack: integer; 232 | {$IFDEF FPC} 233 | ch: UnicodeChar; 234 | {$ELSE} 235 | ch: Char; 236 | {$ENDIF FPC} 237 | begin 238 | if pTxt > '' then 239 | begin 240 | setLength(stack, length(pTxt) div length(MARKER_OPEN)); // it will never need more than this 241 | Nstack:=0; 242 | pars := TPars.Create; 243 | try 244 | i:=1; 245 | row:=1; 246 | lastNL:=0; 247 | while i <= length(pTxt) do 248 | begin 249 | ch := pTxt[i]; 250 | if ch = #10 then 251 | begin 252 | inc(row); 253 | lastNL:=i; 254 | end; 255 | if not (ch in ID2TAG_1Chars) then 256 | begin 257 | Inc(i); 258 | Continue; 259 | end; 260 | for m:=0 to MAX_MARKER_ID do 261 | begin 262 | if not strAt(pTxt, ID2TAGU[m], i) then 263 | continue; 264 | case m of 265 | QUOTE_ID, 266 | OPEN_ID: 267 | begin 268 | if (m = OPEN_ID) and (Nstack > 0) and stack[Nstack-1].quote then 269 | continue; // don't consider quoted OPEN markers 270 | stack[Nstack].pos := i; 271 | stack[Nstack].quote := m=QUOTE_ID; 272 | stack[Nstack].row := row; 273 | stack[Nstack].col := i-lastNL; 274 | inc(Nstack); 275 | end; 276 | CLOSE_ID: 277 | begin 278 | if Nstack = 0 then 279 | raise EtplError.create('unmatched marker', copy(pTxt,i,30), row, i-lastNL); 280 | if (Nstack > 0) and stack[Nstack-1].quote then 281 | continue; // don't consider quoted CLOSE markers 282 | t := length(MARKER_CLOSE); 283 | inc(i, t-1+expand(stack[Nstack-1].pos, i+t-1)); 284 | dec(Nstack); 285 | end; 286 | UNQUOTE_ID: 287 | begin 288 | if (Nstack = 0) or not stack[Nstack-1].quote then 289 | continue; 290 | dec(Nstack); 291 | end; 292 | end; 293 | end;//for 294 | inc(i); 295 | end; 296 | finally 297 | pars.free 298 | end; 299 | if Nstack > 0 then 300 | with stack[Nstack-1] do 301 | raise EtplError.create('unmatched marker', copy(pTxt,pos,30), row, col) 302 | end; 303 | end; // handleMacros 304 | 305 | begin 306 | if recurLevel > MAX_RECUR_LEVEL then 307 | exit; 308 | inc(recurLevel); 309 | handleSymbols(); 310 | handleMacros(); 311 | end; //applyMacrosAndSymbols2 312 | 313 | procedure applyMacrosAndSymbols(fs: TFileServer; var txt: UnicodeString; cb: TmacroCB; cbData: PMacroData; removeQuotings: Boolean=TRUE); 314 | var 315 | idsStack: TparserIdsStack; 316 | begin 317 | enforceNUL(txt); 318 | applyMacrosAndSymbols2(fs, txt, cb, cbData, idsStack); 319 | if removeQuotings then 320 | txt := xtpl(txt, [MARKER_QUOTE, '', MARKER_UNQUOTE, '']) 321 | end; 322 | 323 | function findMacroMarker(const s: String; ofs: Integer=1): Integer; 324 | begin result:=reMatch(s, '\{[.:]|[.:]\}|\|', 'm!', ofs) end; 325 | 326 | function isAnyMacroIn(const s: RawByteString): Boolean; inline; 327 | begin 328 | result := pos(AMARKER_OPEN, s) > 0 329 | end; 330 | 331 | function anyMacroMarkerIn(const s: String): Boolean; 332 | begin result:=findMacroMarker(s) > 0 end; 333 | {$IFDEF FPC} 334 | function isMacroQuoted(const s: UnicodeString): Boolean; OverLoad; 335 | begin result := AnsiStartsStr(MARKER_QUOTE, s) and ansiEndsStr(MARKER_UNQUOTE, s) end; //????? 336 | {$ENDIF FPC} 337 | 338 | function isMacroQuoted(const s: String): Boolean; OverLoad; 339 | begin result:=ansiStartsStr(MARKER_QUOTE, s) and ansiEndsStr(MARKER_UNQUOTE, s) end; 340 | 341 | function macroQuote(s: UnicodeString): UnicodeString; 342 | var 343 | t: UnicodeString; 344 | begin 345 | enforceNUL(s); 346 | if not anyMacroMarkerIn(s) then 347 | begin 348 | result := s; 349 | exit; 350 | end; 351 | // an UNQUOTE would invalidate our quoting, so let's encode any of it 352 | t := MARKER_UNQUOTE; 353 | replace(t, '&#'+intToStr(charToUnicode(t[1]))+';', 1,1); 354 | result := MARKER_QUOTE+xtpl(s, [MARKER_UNQUOTE, t])+MARKER_UNQUOTE 355 | end; // macroQuote 356 | 357 | function macroDequote(s: UnicodeString): UnicodeString; 358 | begin 359 | result := s; 360 | s := trim(s); 361 | if isMacroQuoted(s) then 362 | result := copy(s, length(MARKER_QUOTE)+1, length(s)-length(MARKER_QUOTE)-length(MARKER_UNQUOTE) ); 363 | end; // macroDequote 364 | 365 | {$IFNDEF UNICODE} 366 | function macroDequote(s: String): String; 367 | begin 368 | result:=s; 369 | s:=trim(s); 370 | if isMacroQuoted(s) then 371 | result:=copy(s, length(MARKER_QUOTE)+1, length(s)-length(MARKER_QUOTE)-length(MARKER_UNQUOTE) ); 372 | end; // macroDequote 373 | {$ENDIF UNICODE} 374 | 375 | function validUsername(const s: String; acceptEmpty: Boolean=FALSE): Boolean; 376 | begin 377 | result := (s = '') and acceptEmpty 378 | or (s > '') and not anyCharIn('/\:?*"<>|;&',s) and (length(s) <= 40) 379 | and not anyMacroMarkerIn(s) // mod by mars 380 | end; 381 | 382 | 383 | end. 384 | -------------------------------------------------------------------------------- /srv/srvConst.pas: -------------------------------------------------------------------------------- 1 | unit srvConst; 2 | {$I NoRTTI.inc} 3 | 4 | interface 5 | uses 6 | Graphics, 7 | Types, SysUtils; 8 | 9 | const 10 | VERSION = '2.5.0 Alpha4 by RD' {$IFDEF CPUX64 } +' x64' {$ENDIF} {$IFDEF FPC } +' FPC' {$ENDIF}; 11 | VERSION_BUILD = '325'; 12 | VERSION_STABLE = {$IFDEF STABLE } TRUE {$ELSE} FALSE {$ENDIF}; 13 | HFS_HTTP_AGENT = 'HFS/'+VERSION; 14 | CURRENT_VFS_FORMAT: integer = 1; 15 | CRLF = #13#10; 16 | CRLFA = RawByteString(#13#10); 17 | TAB = #9; 18 | G_VAR_PREFIX = '#'; 19 | HOURS = 24; 20 | MINUTES = HOURS*60; 21 | SECONDS = MINUTES*60; // Tdatetime * SECONDS = time in seconds 22 | KILO = 1024; 23 | MEGA = KILO*KILO; 24 | CORRUPTED_EXT = '.corrupted'; 25 | COMMENT_FILE_EXT = '.comment'; 26 | COMMENTS_FILE = 'hfs.comments.txt'; 27 | DESCRIPT_ION = 'descript.ion'; 28 | DIFF_TPL_FILE = 'hfs.diff.tpl'; 29 | FILELIST_TPL_FILE = 'hfs.filelist.tpl'; 30 | MACROS_LOG_FILE = 'macros-log.html'; 31 | PROTECTED_FILES_MASK = 'hfs.*;*.htm*;descript.ion;*.comment;*.md5;*.corrupted;*.lnk'; 32 | SESSION_COOKIE = 'HFS_SID_'; 33 | VFS_FILE_IDENTIFIER = 'HFS.VFS'; 34 | STARTING_SNDBUF = 32000; 35 | COMPRESSION_THRESHOLD = 10*KILO; // if more than X bytes, VFS files are compressed 36 | BYTES_GROUPING_THRESHOLD: TDateTime = 1/SECONDS; // group bytes in log 37 | DOWNLOAD_MIN_REFRESH_TIME: TDateTime = 1/(5*SECONDS); // 5 Hz 38 | sendGraphWidth = 512; 39 | sendGraphHeight = 32; 40 | 41 | IP_SERVICES_URL = 'http://hfsservice.rejetto.com/ipservices.php'; 42 | SELF_TEST_URL = 'http://hfstest.rejetto.com/'; 43 | 44 | ETA_FRAME = 5; // time frame for ETA (in seconds) 45 | 46 | USER_ANONYMOUS = '@anonymous'; 47 | USER_ANYONE = '@anyone'; 48 | USER_ANY_ACCOUNT = '@any account'; 49 | 50 | DEFAULT_MIME = 'application/octet-stream'; 51 | DEFAULT_MIME_TYPES: array [0..29] of string = ( 52 | '*.htm;*.html', 'text/html', 53 | '*.jpg;*.jpeg;*.jpe', 'image/jpeg', 54 | '*.gif', 'image/gif', 55 | '*.png', 'image/png', 56 | '*.bmp', 'image/bmp', 57 | '*.ico', 'image/x-icon', 58 | '*.mpeg;*.mpg;*.mpe', 'video/mpeg', 59 | '*.avi', 'video/x-msvideo', 60 | '*.txt', 'text/plain', 61 | '*.css', 'text/css', 62 | '*.js', 'text/javascript', 63 | '*.mkv', 'video/x-matroska', 64 | '*.webp', 'image/webp', 65 | '*.heic', 'image/heic', 66 | '*.heif', 'image/heif' 67 | ); 68 | thumbsShowToExtDefaultStr = '.jpg; .jpeg; .png; .gif; .webp; .bmp; .ico'; 69 | 70 | DOW2STR: array [1..7] of string=( 'Sun','Mon','Tue','Wed','Thu','Fri','Sat' ); 71 | MONTH2STR: array [1..12] of string = ( 'Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec' ); 72 | 73 | //const 74 | // libsBaseUrl = 'http://rejetto.com/hfs/'; 75 | 76 | type 77 | TcharSetA = TSysCharSet; //set of char; 78 | TcharSetW = set of Char deprecated 'Holds Char values in the ordinal range of 0..255 only.'; //set of char; 79 | PstringDynArray = ^TstringDynArray; 80 | {$IFDEF FPC} 81 | TUnicodeStringDynArray = array of UnicodeString; 82 | TProc = procedure(); 83 | TProc = procedure(param: TParam); 84 | TProcO = procedure(param: TParam) of Object; 85 | {$ELSE FPC} 86 | TUnicodeStringDynArray = TStringDynArray; 87 | TUnicodeSearchRec = TSearchRec; 88 | TProcedureOfObject = procedure() of Object; 89 | {$ENDIF FPC} 90 | 91 | Paccount = ^Taccount; 92 | Taccount = record // user/pass profile 93 | user, pwd, redir, notes: string; 94 | wasUser: string; // used in user renaming panel 95 | enabled, noLimits, group: boolean; 96 | link: TStringDynArray; 97 | end; 98 | Taccounts = array of Taccount; 99 | 100 | TdownloadingWhat = ( DW_UNK, DW_FILE, DW_FOLDERPAGE, DW_ICON, DW_ERROR, DW_ARCHIVE ); 101 | 102 | TpreReply = (PR_NONE, PR_BAN, PR_OVERLOAD); 103 | 104 | type 105 | TaccountRecursionStopCase = (ARSC_REDIR, ARSC_NOLIMITS, ARSC_IN_SET); 106 | 107 | const 108 | ILLEGAL_FILE_CHARS = [#0..#31,'/','\',':','?','*','"','<','>','|']; 109 | ENCODED_TABLE_HEADER = 'this is an encoded table'+CRLF; 110 | 111 | const // Messages 112 | MSG_SPEED_KBS = '%.1f kB/s'; 113 | 114 | resourcestring 115 | MSG_MAX_CON = 'Max connections'; 116 | MSG_MAX_CON_SING = 'Max connections from single address'; 117 | MSG_MAX_SIM_ADDR = 'Max simultaneous addresses'; 118 | MSG_MAX_SIM_ADDR_DL = 'Max simultaneous addresses downloading'; 119 | MSG_MAX_SIM_DL_SING = 'Max simultaneous downloads from single address'; 120 | MSG_MAX_SIM_DL = 'Max simultaneous downloads'; 121 | 122 | implementation 123 | 124 | end. 125 | -------------------------------------------------------------------------------- /srv/srvVars.pas: -------------------------------------------------------------------------------- 1 | unit srvVars; 2 | {$I NoRTTI.inc} 3 | 4 | interface 5 | uses 6 | Classes, Types, iniFiles, regexpr, 7 | hsLib, srvClassesLib, srvConst; 8 | 9 | // global variables 10 | var 11 | globalLimiter: TspeedLimiter; 12 | ip2obj: THashedStringList; 13 | sessions: Tsessions; 14 | etags: THashedStringList; 15 | forwardedMask: string; 16 | defaultIP: string; // the IP address to use forming URLs 17 | autoupdatedFiles: TstringToIntHash; // download counter for temp Tfile.s 18 | updateASAP: string; 19 | iconsCache: TiconsCache; 20 | filesStayFlaggedForMinutes: integer; 21 | autoFingerprint: integer; // create fingerprint on file addition 22 | toAddFingerPrint: TStringList; 23 | usersInVFS: TusersInVFS; // keeps track of user/pwd in the VFS 24 | loadingVFS: record 25 | resetLetBrowse, unkFK, disableAutosave, visOnlyAnon, bakAvailable, useBackup, macrosFound: boolean; 26 | build: string; 27 | end; 28 | VFSmodified: boolean; // TRUE if the VFS changes have not been saved 29 | VFScounterMod: boolean; // if any counter has changed 30 | // listenOn: string; // interfaces HFS should listen on 31 | // port: string; 32 | lastEverySec: TDateTime; 33 | lastActivityTime: Tdatetime; // used for the "no download timeout" 34 | lastFilelistTpl: Tdatetime; 35 | upTime: Tdatetime; // the server is up since... 36 | inTotalOfs, outTotalOfs: int64; // used to cumulate in/out totals 37 | hitsLogged, downloadsLogged, uploadsLogged: integer; 38 | dontLogAddressMask: string; 39 | renamePartialUploads: string; 40 | ipsEverConnected: THashedStringList; 41 | toDelete: Tlist; // connections pending for deletion 42 | customIPservice: string; 43 | mimeTypes, address2name, IPservices: TUnicodeStringDynArray; 44 | thumbsShowToExt: TStringDynArray; 45 | thumbsShowToExtStr: String; 46 | IPservicesTime: TdateTime; 47 | uploadPaths: TstringDynArray; 48 | minDiskSpace: int64; // in MB. an int32 would suffice, but an int64 will save us 49 | selfTesting: boolean; 50 | banlist: array of record ip,comment: String; end; 51 | noReplyBan: boolean; 52 | allowedReferer: string; // check over the Refer header field 53 | speedLimit: real; // overall limit, Kb/s --- it virtualizes the value of globalLimiter.maxSpeed, that's actually set to zero when streaming is paused 54 | speedLimitIP: real; 55 | openInBrowser: string; // to not send the "attachment" suggestion in header 56 | inBrowserIfMIME: boolean; 57 | 58 | maxConnections: integer; // max number of connections (total) 59 | maxConnectionsIP: integer; // ...from a single address 60 | maxContempDLs: integer; // max number of contemporaneous downloads 61 | maxContempDLsIP: integer; // ...from a single address 62 | maxContempDLsUser: integer; // ...from a single user 63 | maxIPs: integer; // max number of different addresses connected 64 | maxIPsDLing: integer; // max number of different addresses downloading 65 | 66 | tplFilename: UnicodeString; // when empty, we are using the default tpl 67 | dmBrowserTpl, filelistTpl: Ttpl; 68 | noMacrosTpl: Ttpl; 69 | accounts: Taccounts; 70 | 71 | var 72 | runningOnRemovable: boolean; 73 | exePath: string; 74 | cfgPath, tmpPath: string; 75 | GMToffset: integer; // in minutes 76 | externalIP: string; 77 | 78 | var 79 | onlyDotsRE: TRegExpr; 80 | graph: record 81 | rate: integer; // update speed 82 | lastOut, lastIn: int64; // save bytesSent and bytesReceived last values 83 | maxV: int64; // max value in scale 84 | size: integer; // height of the box 85 | samplesIn, samplesOut: array [0..3000] of int64; // 1 sample, 1 pixel 86 | beforeRecalcMax: integer; // countdown 87 | end; 88 | flashOn: string; // describes when to flash the taskbar 89 | logFile: record 90 | filename: string; 91 | apacheFormat: string; 92 | apacheZoneString: string; 93 | end; 94 | setThreadExecutionState: function(d:dword):dword; stdcall; // as variable, because not available on Win95 95 | 96 | function applyThumbsExtStr(str: String): Boolean; 97 | 98 | implementation 99 | uses 100 | SysUtils, srvUtils; 101 | 102 | function applyThumbsExtStr(str: String): Boolean; 103 | var 104 | arr: TStringDynArray; 105 | begin 106 | try 107 | arr := split(';', str, False); 108 | for var I := Low(arr) to High(arr) do 109 | arr[i] := Trim(arr[i]); 110 | sortArray(arr); 111 | Result := True; 112 | except 113 | Result := False; 114 | end; 115 | if Result then 116 | begin 117 | thumbsShowToExt := arr; 118 | thumbsShowToExtStr := str; 119 | end; 120 | end; 121 | 122 | 123 | 124 | INITIALIZATION 125 | 126 | MIMEtypes := toSA([ 127 | '*.htm;*.html', 'text/html', 128 | '*.jpg;*.jpeg;*.jpe', 'image/jpeg', 129 | '*.gif', 'image/gif', 130 | '*.png', 'image/png', 131 | '*.bmp', 'image/bmp', 132 | '*.ico', 'image/x-icon', 133 | '*.mpeg;*.mpg;*.mpe', 'video/mpeg', 134 | '*.avi', 'video/x-msvideo', 135 | '*.txt', 'text/plain', 136 | '*.css', 'text/css', 137 | '*.js', 'text/javascript', 138 | '*.mkv', 'video/x-matroska', 139 | '*.mp3', 'audio/mp3', 140 | '*.mp4', 'video/mp4', 141 | '*.m3u8', 'application/x-mpegURL', 142 | '*.webp', 'image/webp' 143 | ]); 144 | 145 | applyThumbsExtStr(thumbsShowToExtDefaultStr); 146 | 147 | globalLimiter := TspeedLimiter.create(); 148 | iconsCache := TiconsCache.create(); 149 | 150 | FINALIZATION 151 | 152 | if Assigned(globalLimiter) then 153 | FreeAndNil(globalLimiter); 154 | iconsCache.free; 155 | 156 | end. 157 | --------------------------------------------------------------------------------