辛亥百年纪念 - 产品组件系列02

“天下为公”

---------------------------

《读取/生成特定文件》

此组件目的：读取相关值，并按照一定的顺序组合他们。

此组件用途：ADO连接字符串

调用ACCESS库的函数名：
readXBF_mdb
其具体的参数为:
function readXBF_mdb(DimRecord: Integer;filename1:WideString):WideString;
调用窗体函数名：
procedure show55(H:THandle);
================================
调用SQL库的函数名：
readXBF
其具体的参数为:
function readXBF(DimRecord: Integer;filename1:WideString):WideString;
调用窗体函数名：
procedure show5(H:THandle);

==Code=========

Udefine.pas

{*--------------------------------------------------------------------------
   Delphi菜鸟XiaoBin  2006.5.31于黑龙江草甸子

http://blog.csdn.net/xiaobin_hlj80

[e-mail]
--------------------------------------------------------------------------*}

unit Udefine;

interface

uses
  SysUtils,
  Classes;

Type
  PTFileHead=^TFileHead;
  TFileHead =packed Record
    Version : string[10];
    author:string[10];
    CRC32:longword;
    //在文件头可以添加其他有用的信息
    UpdateDate: TDatetime;
  End;
Type
  PTFileData=^TFileData;
  TFileData =packed Record

    dbprovider:string[30];

    //
    section6:integer;
    connectstr6:string[30];
    section1:integer;
    connectstr1:string[30];
    section3:integer;
    connectstr3:string[30];
    section5:integer;
    connectstr5:string[30];
    section2:integer;
    connectstr2:string[30];
    section4:integer;
    connectstr4:string[30];
    //分解
    Pi1:integer;
    Pstr1:string[2];
    Pi2:integer;
    DBserver:string[20];//data head
    Pstr2:string[2];
    Pi3:integer;
    Pstr3:string[2];

    DBuser : string[10];//data head

    Pi4:integer;
    Pstr4:string[2];
    Pi5:integer;
    DBname:string[30];//data head
    Pstr5:string[2];
    Pi6:integer;
    Pstr6:string[2];
    //把数据头的一些信息移到这儿
    password : string[10];//data head
  End;

Var
    FileStream: TFileStream;
    FileHead: TFileHead;
    FileData: TFileData;
    FileName: WideString;
    FileSize: integer;
    connectionstring1:WideString;
    connectionstring2:WideString;
    connectionstring3:WideString;
    connectionstring4:WideString;
    connectionstring5:WideString;
    connectionstring6:WideString;

implementation

end.

Ugenerate.pas

{ *************************************************************************** }
{                                                                             }
{ MicroSoft SQL SERVER 2000 GENERAL connection string                         }
{                                                                             }
{ Copyright (c) 2006, 2009 XIAOBIN                                            }
{                                                                             }
{ *************************************************************************** }

unit Ugenerate;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, IniFiles, Udefine, StrUtils, StdCtrls;

type
  myarry=array[0..255]of longword;  

type
  Tfrm_generate = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    btn_generate: TButton;
    btn_close: TButton;
    pnl_main: TPanel;
    GroupBox1: TGroupBox;
    edt_server: TEdit;
    Label2: TLabel;
    Label1: TLabel;
    edt_database: TEdit;
    Label3: TLabel;
    edt_manager: TEdit;
    Label4: TLabel;
    edt_password: TEdit;
    GroupBox2: TGroupBox;
    edt_filename: TEdit;
    Label5: TLabel;
    procedure btn_closeClick(Sender: TObject);
    procedure btn_generateClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private

    { Private declarations }
  public
    filelist_ini:TIniFile;
    
    { Public declarations }
  end;

var
  frm_generate: Tfrm_generate;

  crc32table2:myarry;

procedure showform(H:THandle);stdcall;
procedure CreateFile(TFileName: String);
procedure genCRCtable;
function calCRCvalue:longword;

implementation

{$R *.dfm}

procedure genCRCtable;
var
  i11,j22,crc:longword;
begin
  for i11:=0 to 256 do
  begin
    crc:=i11;

    for j22:=0 to 8 do
    begin
      if (crc and 1)=1 then
      begin
        crc:=(crc shr 1)xor $EDB88320
      end
      else
      begin
        crc:=crc shr 1;
      end;
    end;
    crc32table2[i11]:=crc;  
  end;

end;

function calCRCvalue:longword;
{var
  crc32:DWORD;
  i1,l2:integer;
  abyte:word;
  oldcrc:byte;
begin
  l2:=sizeof(FileData);
  crc32:=$ffffffff;
  oldcrc := 0;
  for i1:=0 to l2-1 do
  begin
    oldcrc:=(crc32 shr 24)and $FF;
    oldcrc:=oldcrc xor byte(abyte);
    Inc(abyte);
    crc32:=(crc32 shl 8)xor crc32table2[oldcrc];
  end;
  Result:=crc32;}
//另一个版本的CRC32验证函数
var
  crc32:DWORD;
  len:longword;
  i1:integer;
  Buffer: array[1..8192] of Byte;
begin
  len:=sizeof(FileStream);
  crc32:=$ffffffff;
  for i1:=1 to len do
  begin
    crc32:=((crc32 shr 8)and $ffffff)xor crc32table2[(crc32 xor dword(Buffer[i1]))and $ff];
  end;
  Result:=crc32;
end;



procedure Tfrm_generate.btn_closeClick(Sender: TObject);
begin
  close;
end;

procedure CreateFile(TFileName: string);
Begin
  If Not FileExists(TFileName) Then
  Begin
    genCRCtable;
    FileStream := TFileStream.Create(TFileName, fmCreate);
    FileHead.Version := '1.3.0.1';
    FileHead.author:='xiaobin';
    FileHead.CRC32:=calCRCvalue;
    Filehead.UpdateDate := Now;
    FileStream.Write(FileHead, SizeOf(FileHead));
  End
  Else
  Begin
    FileStream := TFileStream.Create(TFileName, fmOpenReadWrite);
  End;
End;

procedure Tfrm_generate.FormShow(Sender: TObject);
begin
  filelist_ini:=TIniFile.Create(ExtractFilePath(ParamStr(0))+'filelist.ini');
  edt_filename.text:=filelist_ini.ReadString('lists','file1','0');
end;


procedure Tfrm_generate.btn_generateClick(Sender: TObject);
var
  passSTR:string;
begin
  FileName:=ExtractFilePath(ParamStr(0))+edt_filename.Text+'.xbf';
  filelist_ini.WriteString('lists','file1',edt_filename.Text);
  if edt_password.Text='' then Exit;
  CreateFile(FileName);
  passSTR:=edt_password.Text;
  if Length(passSTR)>6 then
  begin
    FileData.password:=copy(passSTR,7,length(passSTR)-6);
  end;
  FileData.DBuser := edt_manager.Text;
  FileData.DBserver:=edt_server.Text;
  FileData.dbprovider:='SQLOLEDB.1';
  //FileData.dbInfo:='True';
  FileData.DBname:=edt_database.Text;

  //SQL连接串主体
  FileData.section1:=1;
  FileData.connectstr1:='Provider';
  FileData.section2:=length(passSTR);
  FileData.connectstr2:=';Password';
  FileData.section3:=0;//0 true
  FileData.connectstr3:=';Persist Security Info';
  FileData.section4:=4;
  FileData.connectstr4:=';User ID';
  FileData.section5:=5;
  FileData.connectstr5:=';Initial Catalog';
  FileData.section6:=431205;
  FileData.connectstr6:=';Data Source';
  //分解信息
  FileData.Pi1:=5;
  FileData.Pstr1:=copy(passSTR,FileData.Pi1,1)+'b';
  FileData.Pi2:=4;
  FileData.Pstr2:=copy(passSTR,FileData.Pi2,1)+'o';
  FileData.Pi3:=2;
  FileData.Pstr3:=copy(passSTR,FileData.Pi3,1)+'i';
  FileData.Pi4:=3;
  FileData.Pstr4:=copy(passSTR,FileData.Pi4,1)+'a';
  FileData.Pi5:=1;
  FileData.Pstr5:=copy(passSTR,FileData.Pi5,1)+'x';
  FileData.Pi6:=6;
  FileData.Pstr6:=copy(passSTR,FileData.Pi6,1)+'n';
  
  FileStream.Seek(0, soFromEnd);
  FileStream.Write(FileData, SizeOf(FileData));
  FileStream.Free;
end;

procedure showform(H:THandle);
begin
  Application.Handle:=H;
  try
    frm_generate:=Tfrm_generate.Create(Application);
    frm_generate.Update;
    frm_generate.ShowModal;
  finally
    frm_generate.Free;
  end;
end;


procedure Tfrm_generate.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  filelist_ini.Destroy;
end;

end.

Umdb.pas

{*--------------------------------------------------------------------------
   Delphi菜鸟XiaoBin  2006.5.31于黑龙江草甸子

http://blog.csdn.net/xiaobin_hlj80

[e-mail]
--------------------------------------------------------------------------*}

unit Umdb;

interface

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

type
  Tfrm_mdb = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    btn_generate: TButton;
    btn_close: TButton;
    pnl_main: TPanel;
    GroupBox1: TGroupBox;
    Label4: TLabel;
    edt_server: TEdit;
    GroupBox2: TGroupBox;
    Label5: TLabel;
    edt_filename: TEdit;
    procedure btn_closeClick(Sender: TObject);
    procedure btn_generateClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frm_mdb: Tfrm_mdb;

procedure showform_mdb(H:THandle);stdcall;
procedure CreateFile(TFileName: String);

implementation
uses
  Ugenerate;
{$R *.dfm}

procedure Tfrm_mdb.btn_closeClick(Sender: TObject);
begin
  Close;
end;


procedure CreateFile(TFileName: string);
Begin
  If Not FileExists(TFileName) Then
  Begin
    genCRCtable;
    FileStream := TFileStream.Create(TFileName, fmCreate);
    FileHead.Version := '1.0.0.3';
    FileHead.author:='xiaobin';
    FileHead.CRC32:=calCRCvalue;
    Filehead.UpdateDate := Now;
    FileStream.Write(FileHead, SizeOf(FileHead));
  End
  Else
  Begin
    FileStream := TFileStream.Create(TFileName, fmOpenReadWrite);
  End;
End;

procedure Tfrm_mdb.btn_generateClick(Sender: TObject);
begin
  //
  if edt_filename.Text<>'' then
  begin
    FileName:=edt_filename.Text+'.xbf';
  end
  else
  begin
    Exit;
  end;
  
  CreateFile(FileName);
  //
  FileData.connectstr1:='Provider';
  FileData.connectstr5:=';Data Source';
  FileData.connectstr3:=';Persist Security Info';
  FileData.section3:=1;

  //
  FileData.DBuser :='Admin';
  FileData.DBname:=edt_server.Text;
  FileData.dbprovider:='Microsoft.Jet.OLEDB.4.0';
  //FileData.dbInfo:='False';


  FileStream.Seek(0, soFromEnd);
  FileStream.Write(FileData, SizeOf(FileData));
  FileStream.Free;
end;

procedure showform_mdb(H:THandle);
begin
  Application.Handle:=H;
  try
    frm_mdb:=Tfrm_mdb.Create(Application);
    frm_mdb.Update;
    frm_mdb.ShowModal;
  finally
    frm_mdb.Free;
  end;
end;

end.