GettickCount64

흔히 서버어플을 만들다 보면 GettickCount를 사용하는 코드들이 있는데

장시간 운영중인 운영체제에서는 해당함수가 -1을 리턴하는경우가 있다.

Delphi2010은 Cardinal 값으로 반환 받는데 cardinal이라면 약 49 일이후에는 GettickCount가

엉뚱한 값을 내뱉는 경우가 발생하여 코드에 따라 예기치 않은 동작을 보이거나 심지어

Access Violation까지 뱉어내기도 한다.



아래 코드를 이용하면 GetTickCount64 함수를 이용할 수 있는데

무려 약 2억9천2백4십7만천2백8년째 가동중인것까지 사용이 가능하다.



출처 : http://www.delphipraxis.net/711170-post5.html

Unit GTCUnit;
// (c) 1997-2007 by FNS Enterprize's (FNSE.de)
// 2003-2007 by himitsu @ Delphi-PRAXiS.de

Interface

Uses Windows;

Var GetTickCount64: Function(): UInt64; StdCall;

Implementation

Function _GetTickCount64: UInt64; StdCall;
Var Freq, Ticks: UInt64;
Begin

  If QueryPerformanceFrequency(Int64(Freq))
     and QueryPerformanceCounter(Int64(Ticks))
     and (Int64(Freq) > 0) Then Begin

    If Ticks >= UInt64(-1) div 1000 Then Result := Ticks div (Freq div 1000)
    Else Result := (Ticks * 1000) div Freq;
    End Else Result := 0;

End;

Initialization
  GetTickCount64 := GetProcAddress(GetModuleHandle('Kernel32.dll'), 'GetTickCount64');
  If @GetTickCount64 = nil Then GetTickCount64 := @_GetTickCount64;
End.

사용예

Uses Windows, GTCUnit;
.....

....

Var C, C2: UInt64;
Begin

C := GetTickCount64();
Sleep(3000);
C2 := GetTickCount64();
Label1.Caption := IntToStr(C2 - C);

End;

VirtualstringTree CheckState

VirtualStringTree의 체크 박스를 강제로 체크 되도록 하려면 아래와 같이 하면 된다.
키포인트는
 TVirtualStringTree(Sender).CheckState[oHitInfo.HitNode] := csUncheckedNormal;
위와 같이 해야 정상적으로 체크 및 언체크 된다.


var
  oHitInfo : THitInfo;

  nTmp1 : TCheckState;
  bTmp1 : boolean;
begin

  if button <> mbLeft then exit;


  TVirtualStringTree(Sender).GetHitTestInfoAt(x-TVirtualStringTree(Sender).OffsetXY.X
                                          ,y - TVirtualStringTree(Sender).OffsetXY.Y,false,oHitInfo);
  if oHitInfo.HitNode = nil then exit;
  if oHitInfo.HitColumn = 0 then exit;

//  vstBookMarkChecking(Sender: TBaseVirtualTree;
//  Node: PVirtualNode; var NewState: TCheckState; var Allowed: Boolean);

  bTmp1 := true;

  if oHitInfo.HitNode.CheckState = csCheckedNormal then begin
    nTmp1 := csUncheckedNormal;
    //oHitInfo.HitNode.CheckState := nTmp1;
    TVirtualStringTree(Sender).CheckState[oHitInfo.HitNode] := csUncheckedNormal;



    TVirtualStringTree(Sender).InvalidateNode(oHitInfo.HitNode);
    TVirtualStringTree(Sender).RepaintNode(oHitInfo.HitNode);
  end else begin
    nTmp1 := cscheckedNormal;
    //oHitInfo.HitNode.CheckState := nTmp1;

    TVirtualStringTree(Sender).CheckState[oHitInfo.HitNode] := cscheckedNormal;
    TVirtualStringTree(Sender).InvalidateNode(oHitInfo.HitNode);
    TVirtualStringTree(Sender).RepaintNode(oHitInfo.HitNode);
  end;

Text 및 File 스트림 암호화 (DES)

{
# 파일 인코딩 디코딩 Unit
# DCP Component need;
--------2010_10_27 GHG-------

}


unit Unit_Crypt;

interface

uses
  Classes, Dialogs, SysUtils, DCPdes, DCPsha512;


function EnCodeFile(sFileName: string): boolean;
function DeCodeFile(sFileName: string): boolean;

function EnCodeText(sText : string) : string;
function DeCodeText(sText : string) : string;


implementation

function EnCodeText(sText : string) : string;
var
  oDcp: TDCP_3Des;
begin

  oDcp := TDcp_3Des.Create(nil);
  try
    try
      oDcp.InitStr(AnsiString(blablablabla), TDCP_sha512);
      result := String(oDcp.EncryptString(AnsiString(sText)));
    except      
      result := '';
    end;
  finally
    oDcp.Free;
  end;

end;

function DeCodeText(sText : string) : string;
var
  oDcp: TDCP_3Des;
begin

  oDcp := TDcp_3Des.Create(nil);
  try
    try
      oDcp.InitStr(AnsiString(blablablabla), TDCP_sha512);
      result := String(oDcp.DecryptString(AnsiString(sText)));
    except      
      result := '';
    end;
  finally
    oDcp.Free;
  end;

end;


function EnCodeFile(sFileName: string): boolean;
var
  oDcp: TDCP_3des;
  oMemStrm1, oMemStrm2: TMemoryStream;
begin


  oDcp := TDCP_3des.Create(nil);
  oMemStrm1 := TMemoryStream.Create;
  oMemStrm2 := TMemoryStream.Create;

  try
    oDcp.InitStr(AnsiString(blablablabla), TDCP_sha512);
    oMemStrm1.LoadFromFile(sFileName);
    oDcp.EncryptStream(oMemStrm1, oMemStrm2, oMemStrm1.size);
    oDcp.Burn;
    result := true;
  finally
    FreeAndNil(oDcp);
    FreeAndNil(oMemStrm1);
  end;

  if oMemStrm2.Size > 0  then begin
    oMemStrm2.SaveToFile(sFileName);
    FreeAndNil(oMemStrm2);
  end;

end;

function DeCodeFile(sFileName: string): boolean;
var
  oDcp: TDCP_3des;
  oMemStrm1, oMemStrm2: TMemoryStream;
begin

  oDcp := TDCP_3des.Create(nil);
  oMemStrm1 := TMemoryStream.Create;
  oMemStrm2 := TMemoryStream.Create;
  try
    oMemStrm1.LoadFromFile(sFileName);
    oDcp.InitStr(AnsiString(blablablabla), TDCP_sha512);
    oDcp.DecryptStream(oMemStrm1, oMemStrm2, oMemStrm1.size);
    oDcp.Burn;
  finally
    FreeAndNil(oDcp);
    FreeAndNil(oMemStrm1);
  end;


  if oMemStrm2.Size > 0  then begin
    oMemStrm2.SaveToFile(sFileName);
    FreeAndNil(oMemsTrm2);
    result := true;
  end else begin
    result := false;
  end;

end;


end.

Hide command-line command runs.

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls , Generics.Collections ;

type
  TCmdProc = class
  private
  FCMDText : string;
    FRun: boolean;
    FProcHandleList : TList;
    FRunCount: integer;
    function GetIsRun: boolean;
    procedure SetRun(const Value: boolean);
    procedure RunExecute;
    procedure KillProcess( hProcess: int64);
  public

  constructor Create;
    destructor Destroy; override;
  property Run : boolean read GetIsRun write SetRun;
  property CMDText : string read FCMDText write FCMDText;
    property RunCount : integer read FRunCount write FRunCount;

  end;


  TForm1 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    Memo1: TMemo;
    Label1: TLabel;
    Button2: TButton;
    Memo2: TMemo;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }

    FCmdProc : TCmdProc;

  public
    { Public declarations }


  end;


var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
memo2.Text := '';
  FCmdProc.FCMDText := Memo1.Lines.Text;
  FCmdProc.RunCount :=StrToIntDef(edit1.Text, 10);
FCmdProc.Run := true;
end;

{ TCmdProc }

constructor TCmdProc.Create;
begin
FRun := false;
  FCmdText := '';

  FProcHandleList := TList.Create;

end;

destructor TCmdProc.Destroy;
begin
FProcHandleList.Clear;
  FreeAndNil(FProcHandleList);

  inherited;
end;

function TCmdProc.GetIsRun: boolean;
begin
result := FRun;
end;

procedure TCmdProc.KillProcess(hProcess: int64);
begin
 if TerminateProcess(hProcess, 0) = FALSE then begin
   form1.memo2.lines.add( InttoStr(hProcess) + ' : KillProcess error !')
 end else begin
   form1.memo2.lines.add( InttoStr(hProcess) + ' : KillProcess successfully !');
 end;
end;

procedure TCmdProc.RunExecute;
var
StartInfo  : TStartupInfo;
  ProcInfo   : TProcessInformation;
  CreateOK   : Boolean;
  i : integer;
begin
  FillChar(StartInfo, SizeOf(TStartupInfo),#0);
  FillChar(ProcInfo,  SizeOf(TProcessInformation),#0);
  StartInfo.cb := SizeOf(TStartupInfo);
  StartInfo.dwFlags := STARTF_USESHOWWINDOW;
  StartInfo.wShowWindow := SW_HIDE;

for I := 1 to FRunCount do begin
    if CreateProcess(nil,PChar(CMDText), nil, nil, False, CREATE_NEW_CONSOLE , nil, nil, StartInfo, ProcInfo) then begin
      if Assigned(FProcHandleList) then begin
        FProcHandleList.Add(InttoStr(ProcInfo.hProcess));
        form1.Memo2.Lines.Add(IntToStr(ProcInfo.hProcess) + ' is Run ');
      end;
    end else begin
form1.Memo2.Lines.Add('CMD Run Fail ');
    end;
  end;

end;

procedure TCmdProc.SetRun(const Value: boolean);
var
  hProc : String;
begin

if Value then begin
    RunExecute;
  end else begin

  while FProcHandleList.Count <> 0 do begin
    hProc := FProcHandleList.Items[0];
  KIllProcess(StrToIntDef(hProc, 0));
      FProcHandleList.Remove(hProc);
    end;
  end;


end;

procedure TForm1.Button2Click(Sender: TObject);
begin
FCmdProc.Run := false;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
FCmdProc := TCmdProc.Create;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
if Assigned(FCmdProc) then begin
  FreeAndNil(FCmdProc);
  end;
end;

end.