使用blowfish加解密

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  g_LibHandle : THandle ;  // dynamic load library
  BlowfishEncodeString : function(lpszString: PChar; lpszKey: PChar;lpszBuffer: PChar; dwBufferSize: DWORD): DWORD; stdcall ;
  BlowfishDecodeString : function(lpszEncodedString: PChar; lpszKey: PChar;lpszBuffer: PChar; dwBufferSize: DWORD): DWORD; stdcall ;
  CalcCrc32 : function(pBuffer: Pointer; dwBufferSize: DWORD): DWORD; stdcall ;
  //加解密
  function  EncrypBlowfishPassword(sPassword    : String): String; //傳入欲加密字串,傳回加密後的字串  {Blowfish}
  function  DecrypBlowfishPassword(sEncrypedPWD : String): String; //傳入加密過的密碼,傳回解密後的明文密碼 {Blowfish}
const
  _BLOWFISH_KEY               = 'FORT_BLOWFISH_KEY';  //使用BlowFish 加密的Key

implementation

{$R *.dfm}
//----------------------------------------------------------------------------//
// LoadAllLibrary 載入所需Dll                                                 //
//                傳回值 :  TRUE  載入成功                                    //
//                          False 載入失敗                                    //
//----------------------------------------------------------------------------//
function  LoadAllLibrary():boolean ;
var
  sPathName :string ;
begin
  Result := true ;
  sPathName := 'C:\facrypto.dll' ;
  g_LibHandle  := LoadLibrary(PAnsiChar(sPathName)) ;
  if( g_LibHandle = 0 ) then
  begin
    showmessage('載入 DLL 發生錯誤');
    Result := false ;
    Exit ;
  end ;

  //加密
  @BlowfishEncodeString := GetprocAddress( g_LibHandle, 'BlowfishEncodeString') ;

  //解密
  @BlowfishDecodeString := GetprocAddress( g_LibHandle, 'BlowfishDecodeString') ;

  //CRC32
  @CalcCrc32 := GetprocAddress( g_LibHandle, 'CalcCrc32') ;

  //若三者有一出錯,即傳回False
  if( (@BlowfishEncodeString=NIL) OR (@BlowfishDecodeString=NIL) OR (@CalcCrc32=NIL) ) then
  begin
    showmessage('載入 DLL 發生錯誤');
    Result := false ;
    Exit ;
  end ;
end ;

procedure FreeAllLibrary() ;
begin
  FreeLibrary(g_LibHandle) ;
end ;

//----------------------------------------------------------------------------//
// EncrypBlowfishPassword 加密欲加密的密碼                                    //
//                        參數 : 明文字串                                     //
//                        傳回值 : 加密後的字串                               //
//----------------------------------------------------------------------------//
function  EncrypBlowfishPassword(sPassword    : String): String;
var
  cEncrypt : array[0..255] of Char;

begin

  try
    { encrypt } // 欲加密字串, 加密參數 ,加密後的秘文,buffer長度
    BlowfishEncodeString( PChar(sPassword), PChar(_BLOWFISH_KEY),cEncrypt, 256) ;

    //轉回字串後傳回
    Result := string(cEncrypt);
  except
    //InfoMsgBox('Encryp Error!!');
    Exit;
  end;

end;

//----------------------------------------------------------------------------//
// DecrypBlowfishPassword 解開被加密後的密文                                  //
//                        參數 : 密文字串                                     //
//                        傳回值 : 解密後的明文字串                           //
//----------------------------------------------------------------------------//
function  DecrypBlowfishPassword(sEncrypedPWD : String): String;
var
  cDecrypt : array[0..255] of Char;

begin

  try
    //解密
    BlowfishDecodeString(PChar(sEncrypedPWD),PChar(_BLOWFISH_KEY), cDecrypt,255) ;

    //轉回字串後 傳回
    Result := string(cDecrypt);
  except
    //InfoMsgBox('Decry Error!!');
    exit;
  end;

end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  if not LoadAllLibrary() then
  begin
    showmessage('Error occurred while loading library') ;
    exit;
  end ;
  caption := EncrypBlowfishPassword('kobe');
  FreeAllLibrary() ;  // free all library
end;

end.

設定目錄或文件的屬性

BOOL SetFileAttributes( LPCTSTR lpFileName, // file name DWORD dwFileAttributes // attributes ); dwFileAttributes : FILE_ATTRIBUTE_ARCHIVE FILE_ATTRIBUTE_HIDDEN FILE_ATTRIBUTE_NORMAL FILE_ATTRIBUTE_NOT_CONTENT_INDEXED FILE_ATTRIBUTE_OFFLINE FILE_ATTRIBUTE_READONLY FILE_ATTRIBUTE_SYSTEM FILE_ATTRIBUTE_TEMPORARY

SetFileAttributes(PChar(s),FILE_ATTRIBUTE_HIDDEN+FILE_ATTRIBUTE_READONLY);

pagecontrol每個tabsheet都是用動態建立的form，節省記憶體

新增一個TPageControl，以及一個TLMDFormDisplay，並將他name命名為fdMainScreen

procedure TForm1.DisplaySimpleForm(ccFormClass:TComponentClass);
begin
  try
    fdMainScreen.UnLoad();
    fdMainScreen.Parent := PageControl1.ActivePage;
    fdMainScreen.Execute(TForm(ccFormClass.Create(Application)));
  except
    exit;
  end;

end;

procedure TForm1.PageControl1Change(Sender: TObject);
begin
  Screen.Cursor := crHourGlass ;
  try
    case PageControl1.ActivePageIndex+1 of
      1 :
        DisplaySimpleForm(TForm2      );
      2 :
        DisplaySimpleForm(TForm3      );
      3 :
        fdMainScreen.UnLoad();
    end;
  finally
    Screen.Cursor := crDefault ;
  end;
end;

更換介面bsSkin中文化

{*******************************************************************}
{                                                                   }
{       Almediadev Visual Component Library                         }
{       BusinessSkinForm                                            }
{       Version 6.50                                                }
{                                                                   }
{       Copyright (c) 2000-2008 Almediadev                          }
{       ALL RIGHTS RESERVED                                         }
{                                                                   }
{       Home:  http://www.almdev.com                                }
{       Support: support@almdev.com                                 }
{                                                                   }
{*******************************************************************}

unit bsconst;

interface

resourcestring

  BS_MI_MINCAPTION = '最小化';
  BS_MI_MAXCAPTION = '最大化';
  BS_MI_CLOSECAPTION = '關閉';
  BS_MI_RESTORECAPTION = '還原';
  BS_MI_MINTOTRAYCAPTION = '縮小到系統列';
  BS_MI_ROLLUPCAPTION = '捲起';

  BS_MINBUTTON_HINT = '最小化';
  BS_MAXBUTTON_HINT = '最大化';
  BS_CLOSEBUTTON_HINT = '關閉';
  BS_TRAYBUTTON_HINT = '縮小到系統列';
  BS_ROLLUPBUTTON_HINT = '捲起';
  BS_MENUBUTTON_HINT = '系統清單';

  BS_EDIT_UNDO = '復原';
  BS_EDIT_COPY = '複製';
  BS_EDIT_CUT = '剪下';
  BS_EDIT_PASTE = '貼上';
  BS_EDIT_DELETE = '刪除';
  BS_EDIT_SELECTALL = '全選';

  BS_MSG_BTN_YES = '&Yes';
  BS_MSG_BTN_NO = '&No';
  BS_MSG_BTN_OK = 'OK';
  BS_MSG_BTN_CLOSE = 'Close';
  BS_MSG_BTN_CANCEL = '取消';
  BS_MSG_BTN_ABORT = '&Abort';
  BS_MSG_BTN_RETRY = '&Retry';
  BS_MSG_BTN_IGNORE = '&Ignore';
  BS_MSG_BTN_ALL = '&All';
  BS_MSG_BTN_NOTOALL = 'N&oToAll';
  BS_MSG_BTN_YESTOALL = '&YesToAll';
  BS_MSG_BTN_HELP = '&Help';
  BS_MSG_BTN_OPEN = '&Open';
  BS_MSG_BTN_SAVE = '儲存';

  BS_MSG_BTN_BACK_HINT = '到上次瀏覽的資料夾';
  BS_MSG_BTN_UP_HINT = '往上移一層';
  BS_MSG_BTN_NEWFOLDER_HINT = '建立新資料夾';
  BS_MSG_BTN_VIEWMENU_HINT = '檢視功能表';
  BS_MSG_BTN_STRETCH_HINT = 'Stretch Picture';


  BS_MSG_FILENAME = '檔名:';
  BS_MSG_FILETYPE = '存檔類型:';
  BS_MSG_NEWFOLDER = '新資料夾';
  BS_MSG_LV_DETAILS = '詳細資料';
  BS_MSG_LV_ICON = '大型圖示';
  BS_MSG_LV_SMALLICON = '小型圖示';
  BS_MSG_LV_LIST = '清單';
  BS_MSG_PREVIEWSKIN = 'Preview';
  BS_MSG_PREVIEWBUTTON = 'Button';
  BS_MSG_OVERWRITE = '您要覆蓋舊檔案嗎?';

  BS_MSG_CAP_WARNING = '警告';
  BS_MSG_CAP_ERROR = '錯誤';
  BS_MSG_CAP_INFORMATION = '通知';
  BS_MSG_CAP_CONFIRM = '確認';
  BS_MSG_CAP_SHOWFLAG = 'Do not display this message again';

  BS_CALC_CAP = 'Calculator';
  BS_ERROR = 'Error';

  BS_COLORGRID_CAP = 'Basic colors';
  BS_CUSTOMCOLORGRID_CAP = 'Custom colors';
  BS_ADDCUSTOMCOLORBUTTON_CAP = 'Add to Custom Colors';

  BS_FONTDLG_COLOR = 'Color:';
  BS_FONTDLG_NAME = 'Name:';
  BS_FONTDLG_SIZE = 'Size:';
  BS_FONTDLG_HEIGHT = 'Height:';
  BS_FONTDLG_EXAMPLE = 'Example:';
  BS_FONTDLG_STYLE = 'Style:';
  BS_FONTDLG_SCRIPT = 'Script:';

  BS_DBNAV_FIRST_HINT = 'FirstRecord';
  BS_DBNAV_PRIOR_HINT = 'PriorRecord';
  BS_DBNAV_NEXT_HINT = 'NextRecord';
  BS_DBNAV_LAST_HINT = 'LastRecord';
  BS_DBNAV_INSERT_HINT = 'InsertRecord';
  BS_DBNAV_DELETE_HINT = 'DeleteRecord';
  BS_DBNAV_EDIT_HINT = 'EditRecord';
  BS_DBNAV_POST_HINT = 'PostEdit';
  BS_DBNAV_CANCEL_HINT = 'CancelEdit';
  BS_DBNAV_REFRESH_HINT = 'RefreshRecord';

  BS_DB_DELETE_QUESTION = 'Delete record?';
  BS_DB_MULTIPLEDELETE_QUESTION = 'Delete all selected records?';

  BS_NODISKINDRIVE = 'There is no disk in Drive or Drive is not ready';
  BS_NOVALIDDRIVEID = 'Not a valid Drive ID';

  BS_FLV_NAME = 'Name';
  BS_FLV_SIZE = 'Size';
  BS_FLV_TYPE = 'Type';
  BS_FLV_LOOKIN = '儲存於: ';
  BS_FLV_MODIFIED = 'Modified';
  BS_FLV_ATTRIBUTES = 'Attributes';
  BS_FLV_DISKSIZE = 'Disk Size';
  BS_FLV_FREESPACE = 'Free Space';

  BS_PRNSTATUS_Paused = 'Paused';
  BS_PRNSTATUS_PendingDeletion = 'Pending Deletion';
  BS_PRNSTATUS_Busy = 'Busy';
  BS_PRNSTATUS_DoorOpen = 'Door Open';
  BS_PRNSTATUS_Error = 'Error';
  BS_PRNSTATUS_Initializing = 'Initializing';
  BS_PRNSTATUS_IOActive = 'IO Active';
  BS_PRNSTATUS_ManualFeed = 'Manual Feed';
  BS_PRNSTATUS_NoToner = 'No Toner';
  BS_PRNSTATUS_NotAvailable = 'Not Available';
  BS_PRNSTATUS_OFFLine = 'Offline';
  BS_PRNSTATUS_OutOfMemory = 'Out of Memory';
  BS_PRNSTATUS_OutBinFull = 'Output Bin Full';
  BS_PRNSTATUS_PagePunt = 'Page Punt';
  BS_PRNSTATUS_PaperJam = 'Paper Jam';
  BS_PRNSTATUS_PaperOut = 'Paper Out';
  BS_PRNSTATUS_PaperProblem = 'Paper Problem';
  BS_PRNSTATUS_Printing = 'Printing';
  BS_PRNSTATUS_Processing = 'Processing';
  BS_PRNSTATUS_TonerLow = 'Toner Low';
  BS_PRNSTATUS_UserIntervention = 'User Intervention';
  BS_PRNSTATUS_Waiting = 'Waiting';
  BS_PRNSTATUS_WarningUp = 'Warming Up';
  BS_PRNSTATUS_Ready = 'Ready';
  BS_PRNSTATUS_PrintingAndWaiting = 'Printing: %d document(s) waiting';
  BS_PRNDLG_PRINTER = 'Printer';
  BS_PRNDLG_NAME = 'Name:';
  BS_PRNDLG_PROPERTIES = 'Properties...';
  BS_PRNDLG_STATUS = 'Status:';
  BS_PRNDLG_TYPE = 'Type:';
  BS_PRNDLG_WHERE = 'Where:';
  BS_PRNDLG_COMMENT = 'Comment:';
  BS_PRNDLG_PRINTRANGE = 'Print range';
  BS_PRNDLG_COPIES = 'Copies';
  BS_PRNDLG_NUMCOPIES = 'Number of copies:';
  BS_PRNDLG_COLLATE = 'Collate';
  BS_PRNDLG_ALL = 'All';
  BS_PRNDLG_PAGES = 'Pages';
  BS_PRNDLG_SELECTION = 'Selection';
  BS_PRNDLG_FROM = 'from:';
  BS_PRNDLG_TO = 'to:';
  BS_PRNDLG_PRINTTOFILE = 'Print to file';
  BS_PRNDLG_ORIENTATION = 'Orientation';
  BS_PRNDLG_PAPER = 'Paper';
  BS_PRNDLG_PORTRAIT = 'Portrait';
  BS_PRNDLG_LANDSCAPE = 'Landscape';
  BS_PRNDLG_SOURCE = 'Source:';
  BS_PRNDLG_SIZE = 'Size:';
  BS_PRNDLG_MARGINS = 'Margins (millimeters)';
  BS_PRNDLG_MARGINS_INCHES = 'Margins (inches)';
  BS_PRNDLG_LEFT = 'Left:';
  BS_PRNDLG_RIGHT = 'Right:';
  BS_PRNDLG_TOP = 'Top:';
  BS_PRNDLG_BOTTOM = 'Bottom:';
  BS_PRNDLG_WARNING = 'There are no printers in your system!';
  BS_FIND_NEXT = 'Find next';
  BS_FIND_WHAT = 'Find what:';
  BS_FIND_DIRECTION = 'Direction';
  BS_FIND_DIRECTIONUP = 'Up';
  BS_FIND_DIRECTIONDOWN = 'Down';
  BS_FIND_MATCH_CASE = 'Match case';
  BS_FIND_MATCH_WHOLE_WORD_ONLY = 'Match whole word only';
  BS_FIND_REPLACE_WITH = 'Replace with:';
  BS_FIND_REPLACE = 'Replace';
  BS_FIND_REPLACE_All = 'Replace All';

  BS_MORECOLORS = 'More colors...';
  BS_AUTOCOLOR = 'Automatic';
  BS_CUSTOMCOLOR = 'Custom...';

  BS_DBNAV_FIRST = 'FIRST';
  BS_DBNAV_PRIOR = 'PRIOR';
  BS_DBNAV_NEXT = 'NEXT';
  BS_DBNAV_LAST = 'LAST';
  BS_DBNAV_INSERT = 'INSERT';
  BS_DBNAV_DELETE = 'DELETE';
  BS_DBNAV_EDIT = 'EDIT';
  BS_DBNAV_POST = 'POST';
  BS_DBNAV_CANCEL = 'CANCEL';
  BS_DBNAV_REFRESH = 'REFRESH';

implementation

end.

讀取檔案版本資訊

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
{===========================================================================}
{           函式敘述:                                                       }
{               將十六進位字串轉換成整數                                    }
{           參數:                                                           }
{               十六進位字串                                                }
{           傳回值:                                                         }
{               轉換後的整數結果。若轉換失敗，會產生Exception               }
{===========================================================================}
function HexToInt(HexValue: String): DWORD;
const
  HexChar: set of Char = ['0'..'9','A'..'F'];
var
  iDegree:      DWORD;
  b:            Byte;
  ch:           Char;
begin
  Result := 0;
  if Length(Trim(HexValue))=0 then
    exit;
  iDegree := 1;
  b := Length(HexValue)+1;
  repeat
    Dec(b);
    ch := UpCase(HexValue[b]);
    // 檢查字元是否無誤
    if not (ch in HexChar) then
    begin
      raise Exception.Create('Unable Convert '+HexValue+' To Integer!');
      exit;
    end;
    if (ch<='9') then
      Result := Result+DWORD((Ord(ch)-48))*iDegree
    else
      Result := Result+DWORD((Ord(ch)-55))*iDegree;
    iDegree := iDegree * 16;
  until (b=1);
end;

//若取得錯誤則回傳''
function GetVersionNo(FilePath: string; var SpecialBuild: Boolean): string;
var VersinInfo: Pchar; //版本資訊
    VersinInfoSize: DWord; //版本資訊size (win32 使用)
    pv_info: PVSFixedFileInfo; //版本格式
    Mversion,Sversion:string; //版本No
begin
  Result := '';
  SpecialBuild := False;
  VersinInfoSize := GetFileVersionInfoSize(pchar(FilePath), VersinInfoSize);
  VersinInfo := AllocMem(VersinInfoSize);
  try
    if GetFileVersionInfo(pchar(FilePath), 0, VersinInfoSize, Pointer(VersinInfo)) then
    begin
      if VerQueryValue(pointer(VersinInfo), '\', Pointer(pv_info), VersinInfoSize) then
      begin
        //取得Special Build
        if (pv_info.dwFileFlags and VS_FF_SPECIALBUILD) = VS_FF_SPECIALBUILD then
          SpecialBuild:= True;
        //取得Product Version
        Mversion := IntToHex(pv_info.dwProductVersionMS, 0);
        Mversion := copy('00000000', 1, 8 - length(Mversion)) + Mversion;
        Sversion := IntToHex(pv_info.dwProductVersionLS, 0);
        Sversion := copy('00000000', 1, 8 - length(Sversion)) + Sversion;
        Result := FloatToStr(HexToInt(copy(MVersion, 1, 4))) + '.' +
            FloatToStr(HexToInt(copy(MVersion, 5, 4))) + '.' +
            FloatToStr(HexToInt(copy(SVersion, 1, 4))) + '.' +
            FloatToStr(HexToInt(copy(SVersion, 5, 4)));
      end;
    end;
  finally
    FreeMem(VersinInfo, VersinInfoSize);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  v: string;
  b: boolean;
begin
  v := GetVersionNo('C:/SendReport.exe', b);
  if v<>'' then
  begin
    print v,b;  
  end;
end;

end.

若須一直Select資料庫,可採用TVirtualTable

1.SELECT所有資料至VT5
2.

    VT5.DisableControls;
    VT5.First;

    While not VT5.Eof do
    begin
      if Pos(SearchName,UpperCaseEx(VT5.FieldValues['swname']))<>0 then
      begin

        //FieldValues['swid']:=VT5.FieldValues['swid'];
        //FieldValues['swname']:=VT5.FieldValues['swname'];
        //FieldValues['swver']:=VT5.FieldValues['swver'];
        //FieldValues['snum']:=VT5.FieldValues['num'];

        VT5.Delete;
        Break;
      end else
        VT5.next;
    end;
    VT5.First;
    VT5.EnableControls;

判斷圖片是否全白

function BMPisWhite(Bmp: TBitmap): Boolean;
type
  PRGBTripleArray = ^TRGBTripleArray;
  TRGBTripleArray = array[0..32767] of TRGBTriple;
var
  x, y:   integer;
  p0  :   PRGBTripleArray;
begin
  Result:=True;
  Bmp.PixelFormat := pf24bit;
  for y:=0 to Bmp.Height-1 do
  begin
    p0 := Bmp.ScanLine[y];
    for x:=0 to Bmp.Width-1 do
    begin
      if (p0[x].rgbtBlue <> 255) or (p0[x].rgbtGreen <> 255) or (p0[x].rgbtRed <> 255) then
      begin
        Result := False;
        Exit;
      end;
    end;
  end;
end;

同時更新DB方法

//******************************************************************************
//* InitADOQueryUpdateBatch: 設定UpdateBatch專用的TADOQuery物件                *
//*                    (例如轉換資料表格式)所需要的參數                        *
//* 1. UpdateBatch方法要怎麼用?                                                *
//* 答﹕啟用UpdateBatch功能的前提條件﹕                                        *
//*     使用ADO之BatchUpdate功能之前提條件                                     *
//*     CursorType屬性值需為﹕ctKeySet 或 ctStatic                             *
//*     a. LockType屬性值需為﹕LtBatchUpdate                                   *
//*     b. 執行的SQL敘述需為﹕Select 敘述                                      *
//*     c. CursorLocation屬性值需為﹕clUseClient                               *
//*     當CursorLocation屬性值為clUseServer時也可使用BatchUpdate功能﹐         *
//*     只是說其缺點是無法使用ADO的Briefcase模型功能﹐且在執行效率上不佳﹒     *
//*                                                                            *
//* 2. 完成如上的設定就已經自動開啟UpdateBatch功能了﹐                         *
//*    在對資料庫進行異動時（如Post, Insert, Delete）﹐                        *
//*    並非對后端的資料庫來源﹐而是針對前端的快取記憶體中的資料而言﹐          *
//*    因為Batchupdate功能已將后端資料庫中的資料抓取到前端的快取記憶體中了﹐   *
//*    回存后端資料庫時請參考第3點                                             *
//*                                                                            *
//* 3. 在使用BATCHUPDATE時該怎麼做才會將資料寫到資料庫呢?                      *
//*   3-1 當需要把快取記憶體中所有的異動回存到后端資料庫來源﹕                 *
//*   begin                                                                    *
//*     ADODataSet1.UpdateBatch;                                               *
//*   end;                                                                     *
//*                                                                            *
//*   3-2 當需要把快取記憶體中所有的異動取消﹐                                 *
//*       即放棄之前在快取記憶體中的異動﹐不回存到后端資料庫﹕                 *
//*   begin                                                                    *
//*     ADODataSet1.CancelBatch;                                               *
//*   end;                                                                     *
//******************************************************************************
procedure TRecUIControl.InitADOQueryUpdateBatch(ADOQueryUB: TADOQuery);
begin
  // 設定ADOQueryUB物件所需參數
  with ADOQueryUB do
  begin
    CommandTimeout := 1200;
    Connection     := m_ADOConnectionBT;       //
    CursorLocation := clUseClient;             // Connection is client-side
    CursorType     := ctStatic ;              // Only ctStatic is supported if the CursorLocation property is set to clUseClient
    LockType       := ltBatchOptimistic;       // For batch update mode rather than immediate update mode
    SQL.Clear;
  end;
end;
////////////
  bUpdateOK := True;
  ADOQuery1.Connection.BeginTrans; // 使用交易機制，確保更新無誤
  for i:=0 to TreeMember.Items.Count-1 do
  begin
    sUserID:=TreeMember.Items[i].ColumnText[1];
    sSQL:=     'UPDATE usertable SET appliedsetting=' + IntToStr(APPLY_ONE_GROUP) +' WHERE userid=' + sUserID +';';
    sSQL:=sSQL+'UPDATE grouptouser SET selected=0 WHERE userid=' + sUserID +';';
    sSQL:=sSQL+'UPDATE grouptouser SET selected=1 WHERE userid=' + sUserID +' AND groupid=' + m_sID+';';
    if not SQLExecuteOK(ADOQuery1,sSQL) then
    begin
      bUpdateOK := False;
      Break;
    end;
  end;
  if not bUpdateOK then
  begin
    ADOQuery1.Connection.RollbackTrans; // 發生問題時，回復交易內容
    Exit;
  end
  else
    ADOQuery1.Connection.CommitTrans;  // 若更新無誤，送出交易內容

cxgrid過濾器變成中文字串

uses cxClasses, cxFilterControlStrs, cxGridStrs, cxFilterConsts;

procedure SetCxGridFilterDialogString();
begin

  //cxFilterBoolOperator
  //cxSetResourceString(@cxSFilterBoolOperatorAnd,'AND');
  //cxSetResourceString(@cxSFilterBoolOperatorOr, 'OR');
  //cxSetResourceString(@cxSFilterBoolOperatorNotAnd, 'NOT AND');
  //cxSetResourceString(@cxSFilterBoolOperatorNotOr, 'NOT OR');
  cxSetResourceString(@cxSFilterRootButtonCaption       ,'過濾器');//'Filter' '過濾器'
  cxSetResourceString(@cxSFilterAddCondition            ,'新增條件(&C)');//'Add &Condition' '新增條件(&C)'
  cxSetResourceString(@cxSFilterAddGroup                ,'新增條件群組(&G)');//'Add &Group' '新增條件群組(&G)'
  cxSetResourceString(@cxSFilterRemoveRow               ,'移除列(&R)');//'&Remove Row' '移除列(&R)'
  cxSetResourceString(@cxSFilterClearAll                ,'清除全部(&A)');//'Clear &All' '清除全部(&A)'
  cxSetResourceString(@cxSFilterFooterAddCondition      ,'新增條件');//'press the button to add a new condition' '新增條件'
  cxSetResourceString(@cxSFilterGroupCaption            ,''          );//'applies to the following conditions'
  cxSetResourceString(@cxSFilterRootGroupCaption        ,''          );//''
  cxSetResourceString(@cxSFilterControlNullString       ,'<空值>');//'' '<空值>'
  cxSetResourceString(@cxSFilterErrorBuilding           ,'無法建立過濾條件');//'Can''t build filter from source' '無法建立過濾條件'

  //FilterDialog
  cxSetResourceString(@cxSFilterDialogCaption                   ,'進階查詢-自訂過濾條件');//'Custom Filter' '進階查詢-自訂過濾條件'
  cxSetResourceString(@cxSFilterDialogInvalidValue              ,'設定值不合法');//'Invalid value' '設定值不合法'
  cxSetResourceString(@cxSFilterDialogUse                       ,'可使用');//'Use' '可使用'
  cxSetResourceString(@cxSFilterDialogSingleCharacter           ,'代表任何單一字元');//'to represent any single character' '代表任何單一字元'
  cxSetResourceString(@cxSFilterDialogCharactersSeries          ,'代表任何連續字串');//'to represent any series of characters' '代表任何連續字串'
  //cxSetResourceString(@cxSFilterDialogOperationAnd, 'AND');
  //cxSetResourceString(@cxSFilterDialogOperationOr, 'OR');
  cxSetResourceString(@cxSFilterDialogRows                      ,'請輸入過濾條件');//'Show rows where:' '請輸入過濾條件'

  // FilterControlDialog
  cxSetResourceString(@cxSFilterControlDialogCaption            ,'進階查詢-過濾編輯器');//'Filter builder'  '進階查詢-過濾編輯器'
  cxSetResourceString(@cxSFilterControlDialogNewFile            ,'未命名.flt');//'untitled.flt  '未命名.flt'
  cxSetResourceString(@cxSFilterControlDialogOpenDialogCaption  ,'開啟已存在的過濾條件');//'Open an existing filter' '開啟已存在的過濾條件'
  cxSetResourceString(@cxSFilterControlDialogSaveDialogCaption  ,'儲存過濾條件至檔案');//'Save the active filter to file' '儲存過濾條件至檔案'
  cxSetResourceString(@cxSFilterControlDialogActionSaveCaption  ,'另存新檔...');//'Save As...' '另存新檔...'
  cxSetResourceString(@cxSFilterControlDialogActionOpenCaption  ,'開啟...');//'Open...'  '開啟...'
  cxSetResourceString(@cxSFilterControlDialogActionApplyCaption ,'套用');//'Apply' '套用'
  cxSetResourceString(@cxSFilterControlDialogActionOkCaption    ,'確定');//'OK'  '確定'
  cxSetResourceString(@cxSFilterControlDialogActionCancelCaption,'取消'); //'Cancel' '取消'
  //cxSetResourceString(@cxSFilterControlDialogFileExt, 'flt');
  //cxSetResourceString(@cxSFilterControlDialogFileFilter, 'Filters (*.flt)|*.flt');


  //cxGrid主視窗類
  //cxSetResourceString(@scxGridRecursiveLevels ,'');// 'You cannot create recursive levels');
  //cxSetResourceString(@scxGridDeletingConfirmationCaption ,'');// 'Confirm');
  //cxSetResourceString(@scxGridDeletingFocusedConfirmationText ,'');// 'Delete record?');
  //cxSetResourceString(@scxGridDeletingSelectedConfirmationText ,'');// 'Delete all selected records?');
  cxSetResourceString(@scxGridNoDataInfoText                      ,'<無資料顯示>');// ''); '<無資料顯示>'
  //cxSetResourceString(@scxGridNewItemRowInfoText ,'');// 'Click here to add a new row');
  //cxSetResourceString(@scxGridFilterIsEmpty ,'');// '');
  cxSetResourceString(@scxGridCustomizationFormCaption            ,'自訂');// 'Customization'); '自訂'
  cxSetResourceString(@scxGridCustomizationFormColumnsPageCaption ,'隱藏欄位');// 'Columns'); '隱藏欄位'
  cxSetResourceString(@scxGridGroupByBoxCaption                   ,'(請拖曳欄位標題至此作為分組檢視依據)');// 'Please Drag a column header here to group by that column'
  cxSetResourceString(@scxGridFilterCustomizeButtonCaption        ,'進階查詢-過濾編輯器'+'...');//'Customize...'  '進階查詢-過濾編輯器'    //原本為373 '自訂過濾條件...'
  //cxSetResourceString(@scxGridColumnsQuickCustomizationHint ,'');// 'Click here to select visible columns');
  cxSetResourceString(@scxGridCustomizationFormBandsPageCaption   ,'類別');// 'Bands');  '類別'
  //cxSetResourceString(@scxGridBandsQuickCustomizationHint ,'');// 'Click here to select visible bands');
  //cxSetResourceString(@scxGridCustomizationFormRowsPageCaption ,'');// 'Rows');
  //cxSetResourceString(@scxGridConverterIntermediaryMissing ,'');// 'Missing an intermediary component!'#13#10'Please add a %s component to the form.');
  //cxSetResourceString(@scxGridConverterNotExistGrid ,'');// 'cxGrid does not exist');
  //cxSetResourceString(@scxGridConverterNotExistComponent ,'');// 'Component does not exist');
  //cxSetResourceString(@scxImportErrorCaption ,'');// 'Import error');
  //cxSetResourceString(@scxNotExistGridView ,'');// 'Grid view does not exist');
  //cxSetResourceString(@scxNotExistGridLevel ,'');// 'Active grid level does not exist');
  //cxSetResourceString(@scxCantCreateExportOutputFile ,'');// 'Can''t create the export output file');
  //cxSetResourceString(@cxSEditRepositoryExtLookupComboBoxItem ,'');// 'ExtLookupComboBox|Represents an ultra-advanced lookup using the QuantumGrid as its drop down control');

  //cxGrid主視窗的Filter類
  cxSetResourceString(@cxSFilterOperatorEqual ,'=');// 'equals';
  cxSetResourceString(@cxSFilterOperatorNotEqual ,'!=');// 'does not equal';
  cxSetResourceString(@cxSFilterOperatorLess ,'<');// 'is less than';
  cxSetResourceString(@cxSFilterOperatorLessEqual ,'<=');// 'is less than or equal to';
  cxSetResourceString(@cxSFilterOperatorGreater ,'>');// 'is greater than';
  cxSetResourceString(@cxSFilterOperatorGreaterEqual ,'>=');// 'is greater than or equal to';
  //cxSetResourceString(@cxSFilterOperatorLike ,'');// 'like';
  //cxSetResourceString(@cxSFilterOperatorNotLike ,'');// 'not like';
  //cxSetResourceString(@cxSFilterOperatorBetween ,'');// 'between';
  //cxSetResourceString(@cxSFilterOperatorNotBetween , 'not between';
  //cxSetResourceString(@cxSFilterOperatorInList , 'in';
  //cxSetResourceString(@cxSFilterOperatorNotInList , 'not in';
  //cxSetResourceString(@cxSFilterOperatorYesterday , 'is yesterday';
  //cxSetResourceString(@cxSFilterOperatorToday ,'');//'is today';
  //cxSetResourceString(@cxSFilterOperatorTomorrow ,'');// 'is tomorrow';
  //cxSetResourceString(@cxSFilterOperatorLastWeek ,'');// 'is last week';
  //cxSetResourceString(@cxSFilterOperatorLastMonth ,'');// 'is last month';
  //cxSetResourceString(@cxSFilterOperatorLastYear ,'');// 'is last year';
  //cxSetResourceString(@cxSFilterOperatorThisWeek ,'');// 'is this week';
  //cxSetResourceString(@cxSFilterOperatorThisMonth ,'');// 'is this month';
  //cxSetResourceString(@cxSFilterOperatorThisYear ,'');// 'is this year';
  //cxSetResourceString(@cxSFilterOperatorNextWeek ,'');// 'is next week';
  //cxSetResourceString(@cxSFilterOperatorNextMonth ,'');// 'is next month';
  //cxSetResourceString(@cxSFilterOperatorNextYear ,'');// 'is next year';
  //cxSetResourceString(@cxSFilterAndCaption ,'');// 'and';
  //cxSetResourceString(@cxSFilterOrCaption ,'');// 'or';
  //cxSetResourceString(@cxSFilterNotCaption ,'');// 'not';
  //cxSetResourceString(@cxSFilterBlankCaption ,'');//'blank';
  // derived
  //cxSetResourceString(@cxSFilterOperatorIsNull ,'');// 'is blank';
  //cxSetResourceString(@cxSFilterOperatorIsNotNull ,'');// 'is not blank';
  //cxSetResourceString(@cxSFilterOperatorBeginsWith ,'');// 'begins with';
  //cxSetResourceString(@cxSFilterOperatorDoesNotBeginWith ,'');// 'does not begin with';
  //cxSetResourceString(@cxSFilterOperatorEndsWith ,'');// 'ends with';
  //cxSetResourceString(@cxSFilterOperatorDoesNotEndWith ,'');// 'does not end with';
  //cxSetResourceString(@cxSFilterOperatorContains ,'');// 'contains';
  //cxSetResourceString(@cxSFilterOperatorDoesNotContain ,'');// 'does not contain';
  // filter listbox's values
  cxSetResourceString(@cxSFilterBoxAllCaption         ,'(全部)');// '(All)'; '(全部)'
  cxSetResourceString(@cxSFilterBoxCustomCaption      ,'(自訂...)');// '(Custom...)'; '(自訂...)'
  cxSetResourceString(@cxSFilterBoxBlanksCaption      ,'(空值)');// '(Blanks)'; '(空值)'
  cxSetResourceString(@cxSFilterBoxNonBlanksCaption   ,'(非空值)');// '(NonBlanks)';  '(非空值)'

  //Menu
  //cxSetResourceString(@cxSGridNone ,'');//'None';
  //cxSetResourceString(@cxSGridSortColumnAsc ,'');//'Sort Ascending';
  //cxSetResourceString(@cxSGridSortColumnDesc ,'');//'Sort Descending';
  //cxSetResourceString(@cxSGridClearSorting ,'');//'Clear Sorting';
  //cxSetResourceString(@cxSGridGroupByThisField ,'');//'Group By This Field';
  //cxSetResourceString(@cxSGridRemoveThisGroupItem ,'');//'Remove from grouping';
  //cxSetResourceString(@cxSGridGroupByBox ,'');//'Group By Box';
  //cxSetResourceString(@cxSGridAlignmentSubMenu ,'');//'Alignment';
  //cxSetResourceString(@cxSGridAlignLeft ,'');//'Align Left';
  //cxSetResourceString(@cxSGridAlignRight ,'');//'Align Right';
  //cxSetResourceString(@cxSGridAlignCenter ,'');//'Align Center';
  //cxSetResourceString(@cxSGridRemoveColumn ,'');//'Remove This Column';
  //cxSetResourceString(@cxSGridFieldChooser ,'');//'Field Chooser';
  //cxSetResourceString(@cxSGridBestFit ,'');//'Best Fit';
  //cxSetResourceString(@cxSGridBestFitAllColumns ,'');//'Best Fit (all columns)';
  //cxSetResourceString(@cxSGridShowFooter ,'');//'Footer';
  //cxSetResourceString(@cxSGridShowGroupFooter ,'');//'Group Footers';
  //cxSetResourceString(@cxSGridSumMenuItem ,'');//'Sum';
  //cxSetResourceString(@cxSGridMinMenuItem ,'');//'Min';
  //cxSetResourceString(@cxSGridMaxMenuItem ,'');//'Max';
  //cxSetResourceString(@cxSGridCountMenuItem ,'');//'Count';
  //cxSetResourceString(@cxSGridAvgMenuItem ,'');//'Average';
  //cxSetResourceString(@cxSGridNoneMenuItem ,'');//'None';

end;

自動塞入一萬萬行資料

declare @counter int
set @counter = 0
while @counter <10000begin  set @counter = @counter + 1  print 'The counter is ' + cast(@counter as char)  insert into log (
logdate,userid,pcid,sourcefile,filesize,filehash,writez,logmemo,domainid,hasfile,filelogtype,domain_name,user_name,full_name,compu
ter_name,location,format_tag,dept_name,host_address,backup_path,exe_name,remote_host,is_blocked,dest_drive,dest_drive_type,self_ex
tract_type,fort_server_id) select top 10000
logdate,userid,pcid,sourcefile,filesize,filehash,writez,logmemo,domainid,hasfile,filelogtype,domain_name,user_name,full_name,compu
ter_name,location,format_tag,dept_name,host_address,backup_path,exe_name,remote_host,is_blocked,dest_drive,dest_drive_type,self_ex
tract_type,fort_server_id from log
end

CoreBoot系統改讀其路徑

uses Registry;

Function GetCoreBootValue : string;
var
  reg:TRegistry;
  skey : string;
begin
  Result := '';
  reg:=TRegistry.create;
  try
    reg.RootKey:=HKEY_LOCAL_MACHINE;
    skey:='SYSTEM\CurrentControlSet\Services\Coreboot';
    if reg.OpenKeyReadOnly(skey) then
    begin
      if(reg.ValueExists('CorebootEnable')) then
      begin
        if (reg.ReadInteger('CorebootEnable')=1) and (reg.ValueExists('CorebootDrive')) then
          Result:=Trim(reg.ReadString('CorebootDrive'));
      end;
      reg.closekey;
    end;
  finally
    reg.free;
  end;
end;

將秒轉成天、小時、分、秒

procedure TForm1.FormCreate(Sender: TObject);
var
  DateTime:TDateTime;
  ASec:integer;
  Hour,Min,Sec,MSec:word;
begin
  ASec:=801;
  //Day:=ASec div 86400;//一天為86400秒
  DateTime:=IncSecond(DateTime,ASec);//轉成TDateTime型態
  DecodeTime(DateTime,Hour,Min,Sec,MSec);//解析成小時,分鐘,秒
  Caption:= IntToStr(Hour)+'小時'+IntToStr(Min)+'分鐘'+IntToStr(Sec)+'秒';
end;

cxgrid分組加上共幾筆的資訊

//create呼叫
// 設定分組之群組資訊
  SetCxGridSummaryItems(cxGDBTV1);

procedure TfmMain.SetCxGridSummaryItems(cxGDBTV: TcxGridDBTableView);
var
  x: Integer;
  sFormat :String;
begin
  with cxGDBTV.DataController.Summary do
  begin
    BeginUpdate;
    try
      SummaryGroups.Clear;

      DefaultGroupSummaryItems.BeginText := '{';
      DefaultGroupSummaryItems.EndText   := '}';

      // Add summary group
      with SummaryGroups.Add do
      begin
        // Add proposed grouping column(s)
        // 即以這欄位作分組時會顯示summary items的資訊
        for x:=1 to cxGDBTV.ColumnCount-1 do
        begin
         TcxGridTableSummaryGroupItemLink(Links.Add).Column := cxGDBTV.Columns[x-1];
        end;
        // Add summary items
        sFormat := Format('共 %d 筆', [0]);  // '共 0 筆'
        with SummaryItems.Add as TcxGridDBTableSummaryItem do
        begin
          Kind := skCount;   // 計算群組筆數
          Position := spGroup;
          Format := sFormat; // '共 0 筆'
        end;
      end;

      {
      // 增加寫出檔案大小統計功能
      with SummaryGroups.Add do
      begin
        // Add proposed grouping column(s)
        // 即以這欄位作分組時會顯示summary items的資訊
        for x:=1 to cxGDBTV.ColumnCount-1 do
        begin
         TcxGridTableSummaryGroupItemLink(Links.Add).Column := cxGDBTV.Columns[x-1];
        end;
        // Add summary items
        with SummaryItems.Add as TcxGridDBTableSummaryItem do
        begin
          //Column := cxGDBTV.GetColumnByFieldName('filesize');
          //Column  := cxGDBTV.GetColumnByFieldName('filesize');   //GetColumnByFieldName('cxGDBTV1filesize;
          ItemLink := cxGDBTV.GetColumnByFieldName('filesize');
          Kind := skSum;
          Position := spFooter;
          Format := 'TOTAL = 0';
        end;
      end;
      //FooterSummaryItems.Add;
      }
    finally
      EndUpdate;
    end;
  end;
end;

使用sharememory方式在各程式之間傳送參數

//宣告部分，寫入及讀取端程式都要有
const
  _SMWithXMonitorPolicy             =   'XFortMonitorPolicy';

type
  TCmdDataWithMonitorPolicy  =   record    //  policy
    btData1:                    Byte;    //壓縮率
    btData2:                    Byte;    //縮放率
    btData3:                    Byte;    //
    boolData1:                  Boolean;   //是否抓完整圖   ?
    boolData2:                  Boolean;
    boolData3:                  Boolean;
    dwData1:                    DWORD;   //錄影間隔時間(秒)   ?
    dwData2:                    DWORD;   //影像長度(pixel) ?
    dwData3:                    DWORD;   //影像寬度(pixel)  ？
    dwData4:                    DWORD;
    dwData5:                    DWORD;
    dwData6:                    DWORD;
    intData1:                   Integer; //sessionid
    intData2:                   Integer; //usrid
    intData3:                   Integer; //port
    intData4:                   Integer; 
    intData5:                   Integer;
    int64Data1:                 Int64;
    int64Data2:                 Int64;
    dtDateTimeData1:            TDateTime; // Double(8 bytes)
    dtDateTimeData2:            TDateTime;
    ptData1:                    Pointer;
    ptData2:                    Pointer;
    strData1:                   array [0..511] of Char; //IP
    strData2:                   array [0..511] of Char; //擷取端電腦名稱
    strData3:                   array [0..511] of Char;
    strData4:                   array [0..511] of Char;
    strData5:                   array [0..511] of Char;
  end;
  PCmdDataWithMonitorPolicy  =   ^TCmdDataWithMonitorPolicy;


public
    g_hShareMemPolicy       :Thandle;
    g_pShareMemPolicy       :Pointer;

//一端的create須先建立起sharememory
create
  g_hShareMemPolicy := CreateFileMapping(
    $FFFFFFFF,                    // Shared memory File，Handle 傳入 $FFFFFFFF
    nil,                          // 不設定安全屬性
    PAGE_READWRITE,               // 存取模式設定為可讀寫以便行程交換資料
    0,                            // 使用 paging file 時一般將之設為零
    SizeOf(TCmdDataWithMonitorPolicy), // 共享記憶體的大小 2048bytes
    _SMWithXMonitorPolicy);             // 其他的行程將以此名稱參考到選擇共享記憶體

  //MapViewOfFile函數返回一個指向共用記憶體塊的在該程式記憶體空間中有效的指標
  g_pShareMemPolicy :=MapViewOfFile(
    g_hShareMemPolicy ,                  // File-mapping object 的 Handle 值
    FILE_MAP_ALL_ACCESS,          //設為 FILE_MAP_ALL_ACCESS 開放存取
    0,
    0,
    //0);                         // 映射回來的 byte 數
    SizeOf(TCmdDataWithMonitorPolicy));

//將資料寫入sharememory中
procedure TFormMain.Button1Click(Sender: TObject);
begin
  PCmdDataWithMonitorPolicy(g_pShareMemPolicy)^.btData1 := 100;  //壓縮率
  PCmdDataWithMonitorPolicy(g_pShareMemPolicy)^.btData2 := 90;   //縮放率


  PCmdDataWithMonitorPolicy(g_pShareMemPolicy)^.intData1 := 5;   //sessionid
  PCmdDataWithMonitorPolicy(g_pShareMemPolicy)^.intData2 := 33;   //usrid
  PCmdDataWithMonitorPolicy(g_pShareMemPolicy)^.intData3 := 24137;   //port

  //IP
  FillChar(PCmdDataWithMonitorPolicy(g_pShareMemPolicy)^.strData1,SizeOf(PCmdDataWithMonitorPolicy(g_pShareMemPolicy)^.strData1),0);
  StrCopy(PCmdDataWithMonitorPolicy(g_pShareMemPolicy).strData1, PCHAR('10.1.0.3'));

  //擷取端電腦名稱
  FillChar(PCmdDataWithMonitorPolicy(g_pShareMemPolicy)^.strData2,SizeOf(PCmdDataWithMonitorPolicy(g_pShareMemPolicy)^.strData2),0);
  StrCopy(PCmdDataWithMonitorPolicy(g_pShareMemPolicy).strData2, PCHAR('Yivon'));
end;

//讀取sharememory資料
procedure TForm1.Button2Click(Sender: TObject);
var
  piRes :^Integer;
  sTmpFileName : string;
begin
  g_hShareMemPolicy := OpenFileMapping(
    FILE_MAP_ALL_ACCESS,            // Shared memory File，Handle 傳入 $FFFFFFFF
    true,
    _SMWithXMonitorPolicy);             // 其他的行程將以此名稱參考到選擇共享記憶體
  if g_hShareMemPolicy <> 0 then     //判斷這一塊SHAREMEMORY有無配置
  begin
    g_pShareMemPolicy:=MapViewOfFile(
      g_hShareMemPolicy,                  // File-mapping object 的 Handle 值
      FILE_MAP_ALL_ACCESS,          //設為 FILE_MAP_ALL_ACCESS 開放存取
      0,
      0,
    //0);                         // 映射回來的 byte 數
      SizeOf(TCmdDataWithMonitorPolicy));

    Memo1.Lines.add('壓縮率：'+inttostr(PCmdDataWithMonitorPolicy(g_pShareMemPolicy)^.btData1));
    Memo1.Lines.add('縮放率：'+inttostr(PCmdDataWithMonitorPolicy(g_pShareMemPolicy)^.btData2));
    Memo1.Lines.add('SessionID：'+inttostr(PCmdDataWithMonitorPolicy(g_pShareMemPolicy)^.intData1));
    Memo1.Lines.add('usrid：'+inttostr(PCmdDataWithMonitorPolicy(g_pShareMemPolicy)^.intData2));
    Memo1.Lines.add('Port：'+inttostr(PCmdDataWithMonitorPolicy(g_pShareMemPolicy)^.intData3));
    Memo1.Lines.add('IP：'+String(PCmdDataWithMonitorPolicy(g_pShareMemPolicy).strData1));
    Memo1.Lines.add('CapComputerName：'+String(PCmdDataWithMonitorPolicy(g_pShareMemPolicy).strData2));
  end;
end;

初始化ADOConnection函數

procedure TRecUIControl.InitADOConnectionBeginTrans(ADOConnBatchTrans: TADOConnection);
begin
  // 設定ADOConnBatchTrans物件所需參數
  with ADOConnBatchTrans do
  begin
    CommandTimeout   := 300;
    //ConnectOptions   := coAsyncConnect;        // The connection is formed asynchronously
    CursorLocation   := clUseServer;           // Connection is client-side
    LoginPrompt      := False;                 // Don't show the login dialog when connecting to a database
    Provider         := 'SQLOLEDB.1';          //
    ConnectionString := frmMain.ADOConnection1.ConnectionString;  // 取主程式的ConnectionString
  end;
end;

big problem

判斷工作管理員內的某個處理程序是否還存在

uses
    Tlhelp32;

function FindProc(ProcName: string): Boolean;   
var
    OK: Bool;
    hPL: THandle;
    ProcessStruct: TProcessEntry32;
begin
    Result := False;
    hPL := CreateToolHelp32SnapShot(TH32CS_SNAPPROCESS, 0);
    ProcessStruct.dwSize := SizeOf(TProcessEntry32);
    OK := Process32First(hPL, ProcessStruct);
    while OK do
    begin
    if UpperCase(ProcessStruct.szExeFile) = UpperCase(ProcName) then
    begin
      Result := True;   
    end;
    OK := Process32Next(hPL, ProcessStruct);
    end;   
    CloseHandle(hPL);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  if FindProc('bds.exe') then
  begin

  end;

end;



///////////////////new////////////
//加入process的數量判斷,若大於2,一定是重復執行囉~
function FindProc(ProcName: string): integer;
var
    OK: Bool;
    hPL: THandle;
    ProcessStruct: TProcessEntry32;
    i:integer;
begin
  i:=0;
  hPL := CreateToolHelp32SnapShot(TH32CS_SNAPPROCESS, 0);
  ProcessStruct.dwSize := SizeOf(TProcessEntry32);
  OK := Process32First(hPL, ProcessStruct);
  while OK do
  begin
    if UpperCase(ProcessStruct.szExeFile) = UpperCase(ProcName) then
    begin
      i := i+1;
    end;
    OK := Process32Next(hPL, ProcessStruct);
  end;
  Result := i;
  CloseHandle(hPL);
end;

取得Windows的SessionID

windows xp的SessionID從0開始
windows vista的SessionID從1開始.0是給特殊權限如SYSTEM

function GetSessionId:DWord;
type _P2S=function (PId:DWORD; var SId:DWORD):BOOL; stdcall;
var P2S: _P2S;
    Hd :HMODULE;
    SId:DWord;
begin
  Result:=0;
  Hd:=LoadLibrary('Kernel32.dll');
  if Hd<>0 then begin
    @P2S:=GetProcAddress(Hd,'ProcessIdToSessionId');
    if Assigned(P2S) and P2S(GetCurrentProcessId,SId) then Result:=SId;
    FreeLibrary(Hd);
  end;
end;

開啟chm某個關聯的位置網頁

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function HtmlHelpA (hwndcaller:Longint; lpHelpFile:string; wCommand:Longint;dwData:string): HWND;stdcall; external 'hhctrl.ocx'
procedure ShowChmHelp(sTopic:string);
var
  i : integer;
begin
  i:=HtmlHelpA(Application.Handle,Pchar('c:\windows.chm'), 0, sTopic);
  if i=0 then
  begin
    showmessage(' help.chm幫助文件損壞！');
    exit;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  tmp : integer;
begin
  tmp := 10100;
  case tmp of
    10100: ShowChmHelp('Win32GDI/15.htm');
    10101: ShowChmHelp('edtInput.htm');

    else  ShowChmHelp('default.htm');
  end;
end;

end.

StrToDate可能會發生not a valid date

這是因為控制台->地區選項->日期分隔字元或型式有改變。
這是你須用程式去設定其地區選項設定

//設定日期格式為 yyyy/MM/dd
SetLocaleInfo(LOCALE_SYSTEM_DEFAULT, LOCALE_SSHORTDATE, 'yyyy/MM/dd') ;

//設定日曆格式為1 型式
SetLocaleInfo(LOCALE_SYSTEM_DEFAULT, LOCALE_ICALENDARTYPE, '1') ;