星期三, 11月 12, 2008

讀取檔案版本資訊

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.

星期二, 11月 04, 2008

若須一直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;