讀取檔案版本資訊

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') ;

寫網卡MAC到exe檔裡，並在程式開始時做判斷

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Edit4: TEdit;
    Edit5: TEdit;
    Edit6: TEdit;
    Button1: TButton;
    Label1: TLabel;
    SaveDialog1: TSaveDialog;
    Button2: TButton;
    Edit7: TEdit;
    Button3: TButton;
    Label2: TLabel;
    procedure Button2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

type
  DWordA  =array [0..7] of DWord;
  DWordP  =^DWordA;
  DWordB  =array [0..7] of Byte;
var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button2Click(Sender: TObject);
begin
  if SaveDialog1.Execute then
    Edit7.Text := SaveDialog1.FileName ;
end;

function UpdateExe(N:string; ChkL:DWord; ChkH:DWord):boolean;    // Write CRC to file
var
  Hd,i:integer;
  D,R:DWordB;    // $1E
begin
  Result:=False;
  DWordP(@D[0])[0]:=ChkL; //20處開始由低位元塞CRC資料 若為DWordP(@D[3])[0] 則是從21處開始塞
  DWordP(@D[4])[0]:=ChkH;

  if FileExists(N) then
  begin
    Hd:=FileOpen(N,fmOpenReadWrite); //開啟N
    FileSeek(Hd,$20,0);
    FileWrite(Hd,D[0],8); //從20開始寫入8個byte值
    FileSeek(Hd,$20,0);
    FileRead(Hd,R[0],8);
    //檢查
    Result:=TRUE;
    for i:=0 to SizeOf(D)-1 do
      if D[i]<>R[i] then
      begin
        Result:=False;
      end;
    FileClose(Hd);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  m1 : DWord;
  m2 : DWord;
begin
  m1 := (strtoint('$'+Edit1.Text) + strtoint('$'+Edit2.Text+'00') + strtoint('$'+Edit3.Text+'0000') + strtoint('$'+Edit4.Text+'000000')) xor $AE5C2DDA;
  m2 := (strtoint('$'+Edit5.Text) + strtoint('$'+Edit6.Text+'00')) xor $0000C1A3;
  UpdateExe(Edit7.Text, m1, m2);

end;

function ReadFileHeader(N:string;var Chk:DWordB):boolean;    // Write CRC to file
var
  Hd : integer;
  R : DWordB;    // $1E
begin
  Result:=False;
  if FileExists(N) then
  begin
    Hd:=FileOpen(N,fmOpenRead); //開啟N
    FileSeek(Hd,$20,0);
    FileRead(Hd,R[0],8);
    CHk := R;
    Result:=True;
    FileClose(Hd);
  end;
end;

function MacAddress: string;
var
  Lib: Cardinal;
  Func: function(GUID: PGUID): Longint; stdcall; 
  GUID1, GUID2: TGUID;
begin
  Result := '';
  Lib := LoadLibrary('rpcrt4.dll');
  if Lib <> 0 then 
  begin 
    if Win32Platform <>VER_PLATFORM_WIN32_NT then 
      @Func := GetProcAddress(Lib, 'UuidCreate')
      else @Func := GetProcAddress(Lib, 'UuidCreateSequential'); 
    if Assigned(Func) then 
    begin 
      if (Func(@GUID1) = 0) and 
        (Func(@GUID2) = 0) and 
        (GUID1.D4[2] = GUID2.D4[2]) and 
        (GUID1.D4[3] = GUID2.D4[3]) and 
        (GUID1.D4[4] = GUID2.D4[4]) and 
        (GUID1.D4[5] = GUID2.D4[5]) and 
        (GUID1.D4[6] = GUID2.D4[6]) and 
        (GUID1.D4[7] = GUID2.D4[7]) then 
      begin 
        Result := 
         IntToHex(GUID1.D4[2] xor $DA, 2) + '-' +
         IntToHex(GUID1.D4[3] xor $2D, 2) + '-' +
         IntToHex(GUID1.D4[4] xor $5C, 2) + '-' +
         IntToHex(GUID1.D4[5] xor $AE, 2) + '-' +
         IntToHex(GUID1.D4[6] xor $A3, 2) + '-' +
         IntToHex(GUID1.D4[7] xor $C1, 2);
      end; 
    end; 
    FreeLibrary(Lib); 
  end;
end;

procedure TForm1.Button3Click(Sender: TObject);
var
  R1: DWordB;    // $1E
begin
  ReadFileHeader(Edit7.Text, R1);
  Label1.Caption:=IntToHex(R1[0],2)+'-'+IntToHex(R1[1],2)+'-'+IntToHex(R1[2],2)+'-'+IntToHex(R1[3],2)+'-'+IntToHex(R1[4],2)+'-'+IntToHex(R1[5],2);
  Label2.Caption:=MacAddress;

  if not SameText(Label1.Caption, Label2.Caption) then
    application.Terminate ;
end;
end.

設定快捷鍵的方法

方法一：
用TActionList來管理

方法二：
安裝ElPack4元件
開到ELPack Tools，選擇ElSysHotKey元件
在其屬性ShortCut就可以修改快捷鍵
Enabled設為true
並在事件OnPress設定為欲執行的事件即可(如Button1.click;)

用訊號燈的方式，限制thread同時執行的數目

MainForm

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
    FSemaphor: THandle;
  public
    { Public declarations }
  end;
var
  Form1: TForm1;
implementation
uses Unit2;
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
  FSemaphor := CreateSemaphore( nil, 3, 3, nil );
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
  CloseHandle( FSemaphor );
end;
procedure TForm1.Button1Click(Sender: TObject);
var
  aIndex: Integer;
  aExchange: TExchange;
begin
  for aIndex := 1 to 20 do
  begin
    if ( WaitForSingleObject( FSemaphor, INFINITE ) = WAIT_OBJECT_0 ) then
    begin
      aExchange := TExchange.Create( True, FSemaphor );
      aExchange.FreeOnTerminate := True;
      aExchange.Resume;
    end;
  end;
end;
end.

Thread

type
  TExchange = class(TThread)
  private
    { Private declarations }
    FSemaphor: THandle;
  protected
    procedure Execute; override;
  public
    constructor Create(CreateSuspended:Boolean; ASemaphor: THandle); reintroduce;
  end;
implementation
{ TExchange }
constructor TExchange.Create(CreateSuspended: Boolean; ASemaphor: THandle);
begin
  inherited Create( CreateSuspended );
  FSemaphor := ASemaphor;
end;
procedure TExchange.Execute;
begin
  while not Self.Terminated do
  begin
    Sleep( 10000 );
    Break;
  end;
  ReleaseSemaphore( FSemaphor, 1, nil );
end;

將組合字串還原存進TStringList陣列的方法

procedure GetSetData(CombinedStr:String;var sl:TStringList);
var
  s : String;
  p,l      : integer;
begin
  sl.Clear;
  l:=Length(CombinedStr);
  if l=0 then exit;
  p:=1;
  while p > 0 do
  begin
    p:=Pos(',,,',CombinedStr);
    if p > 0 then
    begin
      s:=Copy(CombinedStr,1,p-1);
      sl.Add(s);
      CombinedStr:=Copy(CombinedStr,p+3,Length(CombinedStr));
    end;
  end;
  if Length(CombinedStr) > 0 then
  begin
    sl.Add(CombinedStr);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  mysl : TStringList;
begin
  mysl := TStringList.Create;
  try
    GetSetData('oo,,,ertff,,,wett' ,mysl);
    caption := mysl[0]+'__'+mysl[1]+'__'+mysl[2];
  finally
    mysl.Free;
  end;
end;