程式學: 2010

星期二, 12月 21, 2010

Commit到svn的檔案，包括要排除的檔案

Commit至SVN上的程式碼，應 "排除" 編譯器會產生的檔案，如下：

1. (專案檔名).bdsproj

2. (專案檔名).bdsproj.local

3. (專案檔名).drc

4. (專案檔名).dsk

5. (專案檔名).identcache

6. (專案檔名).map

7. (專案檔名).exe

8. *.res -> 其它資源檔，若有產生來源碼方式 (如：用buildRes.bat來產生或已經有rc檔案) 則可以免上傳至SVN

9. *.dcu

10. *.bak

備註:

1. 專案相關檔案，如：dpr、dof、cfg、res (res包含檔案版本資訊)要上傳至SVN上。

2. 程式相關檔案，如：pas、dfm、dll 要上傳至SVN上。

3. 相關資源檔，如：rc、txt、ini、dll、exe、xsl、fr3、ico、bmp...等，以及包括編譯資源檔相關程式檔案要上傳至SVN上。

4. 數位簽章相關檔案，如pfx、dll、cer、exe、bat 要上傳至SVN上。

5. 相關說明文件及圖示檔案，如doc、xls、vsd、ppt、png、bmp...等，則 "視情況上傳" 至SVN上。

星期四, 11月 11, 2010

開啟檔案，若失敗就跳出選擇關聯程式清單


  if OpenDialog1.execute then
  begin
  if ShellExecute(handle, 'Open', PChar(OpenDialog1.FileName), nil, nil, SW_NORMAL) = SE_ERR_NOASSOC then
    ShellExecute(GetDesktopWindow, nil, 'RUNDLL32.EXE',
      PChar('shell32.dll, OpenAs_RunDLL ' + OpenDialog1.FileName),
      PChar(ExtractFilePath(ParamStr(0))), SW_NORMAL);
  end;

星期三, 6月 30, 2010

刪除自己程序


procedure TForm1.Funll;
var
  hModule:THandle;
  buff:array[0..255]of Char;
  hKernel32:THandle;
  pExitProcess,pDeleteFileA,pUnmapViewOfFile:Pointer;
begin
  hModule:=GetModuleHandle(nil);
  GetModuleFileName(hModule, buff, sizeof(buff));
  CloseHandle(THandle(4));
  hKernel32:=GetModuleHandle('KERNEL32');
  pExitProcess:=GetProcAddress(hKernel32, 'ExitProcess');
  pDeleteFileA:=GetProcAddress(hKernel32, 'DeleteFileA');
  pUnmapViewOfFile:=GetProcAddress(hKernel32, 'UnmapViewOfFile');
  asm
  LEA EAX, buff
  PUSH 0
  PUSH 0
  PUSH EAX
  PUSH pExitProcess
  PUSH hModule
  PUSH pDeleteFileA
  PUSH pUnmapViewOfFile
  RET
end;

防止被非explorer.exe程序調用


{注意加載TlHelp32.pas單元}
procedure CheckParentProc;
var //檢查自己的進程的父進程
  Pn: TProcesseNtry32;
  sHandle:THandle;
  H, ExplProc, ParentProc:Hwnd;
  Found:Boolean;
  Buffer:array[0..1023]of Char;
  Path:string;
begin
  H:= 0;
  ExplProc:= 0;
  ParentProc:= 0;
  //得到Windows的目錄
  SetString(Path, Buffer, 200);
  GetWindowsDirectory(Buffer,Sizeof(Buffer)- 1);
  Path:= UpperCase(Path)+ '\EXPLORER.EXE';//得到Explorer的路徑
  //得到所有進程的列表快照
  sHandle:= CreateToolHelp32SnapShot(TH32CS_SNAPALL,0);
  Found:= Process32First(sHandle,Pn);//查找進程
  while Found do //遍歷所有進程
  begin
    if Pn.szExeFile = ParamStr(0) then //自己的進程
    begin
      ParentProc := Pn.th32ParentProcessID;//得到父進程的進程ID
      //父進程的句柄
      H:= OpenProcess(PROCESS_ALL_ACCESS, True, Pn.th32ParentProcessID);
    end
    else if UpperCase(Pn.szExeFile)= Path then
      ExplProc:= Pn.th32ProcessID;//Ex plorer的PID
      Found:= Process32Next(sHandle,Pn);//查找下一個
  end;
  //父進程不是Explorer,是調試器……
  if ParentProc <> ExplProc then
  begin
    showmessage('ok');
    TerminateProcess(H,0);//殺之!除之而後快也! :)
  //你還可以加上其它什麼死機代碼來消遣消遣這位可愛的Cracker:)
  end;
end;

星期二, 6月 08, 2010

刪除目錄下所有檔案


procedure DelTree(sPath: string);
var
  hFind: THandle;
  filename: string;
  fd: WIN32_FIND_DATA;
  bDelete: BOOL;
  i: Integer;

begin
  if sPath='' then
    exit;
  filename:=sPath+'\*.*';
  hFind:=Windows.FindFirstFile(PChar(filename), fd);
  if(hFind <> INVALID_HANDLE_VALUE) then
  begin
    while Windows.FindNextFile(hFind, fd) do
    begin
      filename:=fd.cFileName;
      if((filename = '.') or (filename = '..')) then
        Continue;
      if(fd.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) > 0 then
      begin
        //子目錄
        DelTree(sPath+'\'+filename);
      end
      else
      begin
        //Full filename.
        filename:=sPath+'\'+filename;
        if(not SetFileAttributes(PChar(filename),
            FILE_ATTRIBUTE_NORMAL)) then
        begin
          //SaveLog('Set '+filename+' file attribute to normal error !');
        end;
        i:=0;
        bDelete:=DeleteFile(PChar(filename));
        while((i<5) and (not bDelete)) do
        begin
          Sleep(1000);
          bDelete:=DeleteFile(PChar(filename));
          Inc(i);
        end;
        if(not bDelete) then
        begin
          //SaveLog('Delete file '+filename+' error !');
        end;
      end;
    end;
    Windows.FindClose(hFind);
  end;
  if(not SetFileAttributes(PChar(sPath),
            FILE_ATTRIBUTE_NORMAL)) then
  begin
    //SaveLog('Set '+sPath+' directory attribute to normal error !');
  end;
  //SaveLog('Remove directory '+sPath);
  if(not RemoveDirectory(PChar(sPath))) then
  begin
    //SaveLog('Remove directory '+sPath+' error !');
  end;
  //SaveLog('CcyDelTree '+sPath+' completely.');
end;

星期一, 6月 07, 2010

取得PROGRAM FILES目錄位置


procedure TForm1.Button1Click(Sender: TObject);
begin
  With TRegistry.Create do
  try
    RootKey := HKEY_LOCAL_MACHINE;
    if OpenKey('Software\Microsoft\Windows\CurrentVersion', False) then
      Caption := ReadString('ProgramFilesDir');
  finally
    Free;
  end;
end;

星期五, 6月 04, 2010

判斷作業系統


function GetOSVer: integer ;
var
  vi:   _OSVERSIONINFO;
begin
  Result:=osUnknow;
  FillChar(vi, SizeOf(vi), 0);
  vi.dwOSVersionInfoSize := SizeOf(vi);
  Windows.GetVersionEx(vi);

  if (Win32Platform=1) then begin
    if (Win32MinorVersion=0) then begin
      Result:=osWin95;
    end else begin
      Result:=osWin98;
    end;
  end else if (Win32Platform=2) then begin
    if (Win32MajorVersion=4) then begin
      Result:=osWinNT
    end else if (Win32MajorVersion=5) then begin
      if (Win32MinorVersion=0) then begin
        Result:=osWin2K;
      end else if (Win32MinorVersion=1) begin
        Result:=osWinXP;
      end else begin
        Result:=osVista;
      end;
    end;
  end;
end;
參考網址：
http://www.ge.net.tw/?q=node/919

星期二, 6月 01, 2010

日期轉成星期幾


const
  Arab: array[1..7] of String = ('日','一' ,'二' ,'三' ,'四' , '五' , '六');
begin
  Caption := '星期'+Arab[DayOfWeek(DataSet.FieldByName('完成修正日期').AsDateTime)];
end;

星期三, 5月 26, 2010

cxgrid要能取消選擇的作法

cxgrid 的optionSelection屬性MultiSelect設為True

cxGDBTV1MouseDown事件設定


procedure TfrmDataSwSelect.cxGDBTV1MouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  i : integer;
begin

  i := cxGDBTV1.DataController.FocusedRowIndex;
  cxGDBTV1.DataController.ClearSelection; //清除
  cxGDBTV1.DataController.SelectRows(i,i);
end;

cxGDBTV1KeyDown事件設定


procedure TfrmDataSwSelect.cxGDBTV1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if (ssShift in Shift) then //shift要失效
    Key :=0;
end;

清楚選取用


  cxGDBTV1.DataController.ClearSelection;

初始時將cxgrid移到特定的選擇可用


    ADOQuery1.First;
    if ADOQuery1.Locate('swid', swid, []) then
      iIndex := ADOQuery1.RecNo-1
    else
      iIndex:=-1;
    if iIndex>=0 then
      cxGDBTV1.DataController.SelectRows(iIndex,iIndex);

星期三, 5月 19, 2010

檢查MDAC2.8是否有安裝

dpr下寫


if not CheckMDACVersionOK( _MDAC_V26 ) then
  begin
    OneBtnMsgBox(LoginLangInfo.g_saMsg[160], MB_ICONINFORMATION);// 資料庫存取發生錯誤!//請先安裝 MDAC 2.8 或以上版本。
    exit;
end;

呼叫到的funcion


uses registry;

const
  _MDAC_V26                   = '2.6';             //MDAC 2.6 SQL Server 所需

//----------------------------------------------------------------------------//
// CheckMDACVersionOK  檢查MDAC版本是否夠新                                   //
//                  支援postgreSql後改為外部傳參數決定版本  by FBI 2005-1108  //
//                     參數:                                                  //
//                          (1) sVer : 檢查版號                               //
//----------------------------------------------------------------------------//
function  CheckMDACVersionOK(sVer : String):boolean;
var
  Reg     :TRegistry;
  sVersion:string;

begin
  Result:=false;
  Reg:=TRegistry.Create;
  try
    Reg.RootKey:=HKEY_LOCAL_MACHINE;
    if not Reg.OpenKeyReadOnly('\SOFTWARE\Microsoft\DataAccess') then exit;
    sVersion:=Reg.ReadString('FullInstallVer');
    if sVersion='' then exit; //讀不到 Key，代表沒安裝MDAC
  finally
    Reg.Free;
  end;
  //檢查版本: MS 官方文件限制在 MDAC 2.6 以上。
  try
    //sVersion:=Copy(sVersion,1,3);
    if sVersion < sVer then exit;
  except
    exit;
  end;
  Result:=true;
end;

星期二, 5月 18, 2010

cxgrid的header加入右鍵選單

把元件TcxGridPopupMenu拉進來，grid屬性設定好要的cxgrid,onpopup事件加入下面程式碼


uses cxGridStdPopupMenu;

type
  TMenuStringForCxGrid = class(TObject)
  class procedure HeaderMenuProc(Sender:TObject);
  end;

class procedure TMenuStringForCxGrid.HeaderMenuProc(Sender: TObject);
var
  HM:TcxGridStdHeaderMenu;
begin
  HM:=TcxGridStdHeaderMenu(Sender);
  if HM.Items.Count<>17 then exit;
  HM.Items[0].Caption:='&遞增排序';//遞增排序
  HM.Items[1].Caption:='&遞減排序';//遞減排序
  HM.Items[2].Caption:='&取消排序';//取消排序

  HM.Items[4].Caption:='&以此欄位分組';//以此欄位分組
  HM.Items[5].Caption:='&分組視窗';//分組視窗
  HM.Items[6].Visible:=false;
  HM.Items[7].Visible:=false;
  HM.Items[8].Visible:=false;

  HM.Items[10].Caption:='&隱藏此欄位';//隱藏此欄位
  HM.Items[11].Caption:='&欄位選擇視窗';//欄位選擇視窗

  HM.Items[13].Visible:=false;
  HM.Items[14].Caption:='&最適欄寬';//最適欄寬
  HM.Items[15].Visible:=false;
  HM.Items[16].Caption:='&最適欄寬(所有欄位)';//最適欄寬(所有欄位)

end;

PopCxGridMenuProc(ASenderMenu);  //右鍵選單中文化

//這個是呼叫到的funcion
function  PopCxGridMenuProc(ASenderMenu: TComponent):boolean;
begin
  if ASenderMenu is TcxGridStdHeaderMenu then
    TcxGridStdHeaderMenu(ASenderMenu).OnPopup := TMenuStringForCxGrid.HeaderMenuProc;
  result:=true;
end;

星期五, 5月 07, 2010

使用stuff將多筆記錄合併成一筆並用逗號分隔


select stuff((select ','+user_name From im_chat_log where id in (1, 2) FOR XML PATH('')),1,1,'' ) as xylist

訂閱：文章 (Atom)

程式學

關於我自己

Archives

Subscribe

Powered By