Changeset 34 for trunk/Components/Common/UCommon.pas
- Timestamp:
- Nov 25, 2017, 12:27:33 AM (7 years ago)
- Location:
- trunk
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk
- Property svn:ignore
-
old new 3 3 backup 4 4 tunneler.exe 5 tunneler.dbg 6 tunneler.lps 5 7 heaptrclog.trc 6 tunneler.lps 8 Components/Common/Languages/*.mo 9 Components/CoolTranslator/Demo/lib
-
- Property svn:ignore
-
trunk/Components/Common/UCommon.pas
r31 r34 6 6 7 7 uses 8 {$IFDEF Windows}Windows,{$ENDIF} 8 {$ifdef Windows}Windows,{$endif} 9 {$ifdef Linux}baseunix,{$endif} 9 10 Classes, SysUtils, StrUtils, Dialogs, Process, LCLIntf, 10 11 FileUtil; //, ShFolder, ShellAPI; … … 48 49 function LoggedOnUserNameEx(Format: TUserNameFormat): string; 49 50 function SplitString(var Text: string; Count: Word): string; 51 function GetBitCount(Variable: QWord; MaxIndex: Integer): Integer; 50 52 function GetBit(Variable: QWord; Index: Byte): Boolean; 53 procedure SetBit(var Variable: Int64; Index: Byte; State: Boolean); overload; 51 54 procedure SetBit(var Variable: QWord; Index: Byte; State: Boolean); overload; 52 55 procedure SetBit(var Variable: Cardinal; Index: Byte; State: Boolean); overload; … … 62 65 procedure ExecuteProgram(CommandLine: string); 63 66 procedure FreeThenNil(var Obj); 67 function RemoveQuotes(Text: string): string; 68 function ComputerName: string; 69 function OccurenceOfChar(What: Char; Where: string): Integer; 70 function GetDirCount(Dir: string): Integer; 71 function MergeArray(A, B: array of string): TArrayOfString; 72 function LoadFileToStr(const FileName: TFileName): AnsiString; 64 73 65 74 … … 105 114 Find := FindFirst(UTF8Decode(Path + AFileSpec), faAnyFile xor faDirectory, SearchRec); 106 115 while Find = 0 do begin 107 DeleteFile UTF8(Path + UTF8Encode(SearchRec.Name));116 DeleteFile(Path + UTF8Encode(SearchRec.Name)); 108 117 109 118 Find := SysUtils.FindNext(SearchRec); … … 284 293 L: LongWord; 285 294 begin 286 287 295 L := MAX_USERNAME_LENGTH + 2; 288 296 SetLength(Result, L); … … 299 307 end; 300 308 end; 301 309 {$endif} 310 311 function ComputerName: string; 312 {$ifdef mswindows} 313 const 314 INFO_BUFFER_SIZE = 32767; 315 var 316 Buffer : array[0..INFO_BUFFER_SIZE] of WideChar; 317 Ret : DWORD; 318 begin 319 Ret := INFO_BUFFER_SIZE; 320 If (GetComputerNameW(@Buffer[0],Ret)) then begin 321 Result := UTF8Encode(WideString(Buffer)); 322 end 323 else begin 324 Result := 'ERROR_NO_COMPUTERNAME_RETURNED'; 325 end; 326 end; 327 {$endif} 328 {$ifdef unix} 329 var 330 Name: UtsName; 331 begin 332 fpuname(Name); 333 Result := Name.Nodename; 334 end; 335 {$endif} 336 337 {$ifdef windows} 302 338 function LoggedOnUserNameEx(Format: TUserNameFormat): string; 303 339 const … … 336 372 end; 337 373 374 function GetBitCount(Variable: QWord; MaxIndex: Integer): Integer; 375 var 376 I: Integer; 377 begin 378 Result := 0; 379 for I := 0 to MaxIndex - 1 do 380 if ((Variable shr I) and 1) = 1 then Inc(Result); 381 end; 382 338 383 function GetBit(Variable:QWord;Index:Byte):Boolean; 339 384 begin … … 341 386 end; 342 387 388 procedure SetBit(var Variable: Int64; Index: Byte; State: Boolean); 389 begin 390 Variable := (Variable and ((1 shl Index) xor High(QWord))) or (Int64(State) shl Index); 391 end; 392 343 393 procedure SetBit(var Variable:QWord;Index:Byte;State:Boolean); overload; 344 394 begin 345 Variable := (Variable and ((1 shl Index) xor QWord($ffffffffffffffff))) or (QWord(State) shl Index);395 Variable := (Variable and ((1 shl Index) xor High(QWord))) or (QWord(State) shl Index); 346 396 end; 347 397 348 398 procedure SetBit(var Variable:Cardinal;Index:Byte;State:Boolean); overload; 349 399 begin 350 Variable := (Variable and ((1 shl Index) xor Cardinal($ffffffff))) or (Cardinal(State) shl Index);400 Variable := (Variable and ((1 shl Index) xor High(Cardinal))) or (Cardinal(State) shl Index); 351 401 end; 352 402 353 403 procedure SetBit(var Variable:Word;Index:Byte;State:Boolean); overload; 354 404 begin 355 Variable := (Variable and ((1 shl Index) xor Word($ffff))) or (Word(State) shl Index);405 Variable := (Variable and ((1 shl Index) xor High(Word))) or (Word(State) shl Index); 356 406 end; 357 407 … … 400 450 401 451 procedure OpenWebPage(URL: string); 402 var403 Process: TProcess;404 Browser, Params: string;405 452 begin 406 453 OpenURL(URL); 407 {try 408 Process := TProcess.Create(nil); 409 Browser := ''; 410 //FindDefaultBrowser(Browser, Params); 411 //Process.Executable := Browser; 412 //Process.Parameters.Add(Format(Params, [ApplicationInfo.HomePage]); 413 Process.CommandLine := 'cmd.exe /c start ' + URL; 414 Process.Options := [poNoConsole]; 415 Process.Execute; 454 end; 455 456 procedure OpenFileInShell(FileName: string); 457 begin 458 ExecuteProgram('cmd.exe /c start "' + FileName + '"'); 459 end; 460 461 function RemoveQuotes(Text: string): string; 462 begin 463 Result := Text; 464 if (Pos('"', Text) = 1) and (Text[Length(Text)] = '"') then 465 Result := Copy(Text, 2, Length(Text) - 2); 466 end; 467 468 function OccurenceOfChar(What: Char; Where: string): Integer; 469 var 470 I: Integer; 471 begin 472 Result := 0; 473 for I := 1 to Length(Where) do 474 if Where[I] = What then Inc(Result); 475 end; 476 477 function GetDirCount(Dir: string): Integer; 478 begin 479 Result := OccurenceOfChar(DirectorySeparator, Dir); 480 if Copy(Dir, Length(Dir), 1) = DirectorySeparator then 481 Dec(Result); 482 end; 483 484 function MergeArray(A, B: array of string): TArrayOfString; 485 var 486 I: Integer; 487 begin 488 SetLength(Result, Length(A) + Length(B)); 489 for I := 0 to Length(A) - 1 do 490 Result[I] := A[I]; 491 for I := 0 to Length(B) - 1 do 492 Result[Length(A) + I] := B[I]; 493 end; 494 495 function LoadFileToStr(const FileName: TFileName): AnsiString; 496 var 497 FileStream: TFileStream; 498 Read: Integer; 499 begin 500 Result := ''; 501 FileStream := TFileStream.Create(FileName, fmOpenRead); 502 try 503 if FileStream.Size > 0 then begin 504 SetLength(Result, FileStream.Size); 505 Read := FileStream.Read(Pointer(Result)^, FileStream.Size); 506 SetLength(Result, Read); 507 end; 416 508 finally 417 Process.Free; 418 end;} 419 end; 420 421 procedure OpenFileInShell(FileName: string); 422 begin 423 ExecuteProgram('cmd.exe /c start "' + FileName + '"'); 424 end; 509 FileStream.Free; 510 end; 511 end; 512 513 425 514 426 515 initialization
Note:
See TracChangeset
for help on using the changeset viewer.