Access技巧集,认为好的请提前.欢迎增加,请不要灌水 (300分)

谢!

Delphi中，我是这样操作Access的日期－－转换成浮点数值型
当初要是看到这个帖子就好了，哈

不过，数值型也是好用，呵呵。

真的不错啊

up

多谢啦。已经收藏了

收藏

多谢啦。已经收藏了

那位兄弟知道delphi怎樣控制access 的報表預覽，比如excel是st.preview,謝了謝了
如果知道，請發mail給我javens@163.net同時祝大家新春快了

不错，希望多一点这样的文章出现。

非常不错，精品

ego能否给我一份呢？多谢。super-ljc@vip.163.com

ego能否给我一份呢？多谢。
mailtojxy@163.com

收藏

up

同意孔明.net,在DELPHI中用ACCESS最好使用PARAMETERS。

发布我的控件，有需要帮助文件请留EMAIL，如有BUG或新的意见请及时反馈给我。
顺便看看这个问题。
http://www.delphibbs.com/delphibbs/dispq.asp?lid=1538691


{*******************************************************}
{ }
{ Borland Delphi Visual Component Library }
{ }
{ Copyright (c) 2001, 2002 by EastRich }
{ }
{ Email: Eastdak@cmmail.com }
{ }
{*******************************************************}

unit msAccessTools;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Comobj, DAO97, ADODB, DsgnIntf, TypInfo;

const
err_NOFILENAME = '文件名称不存在...';
err_FILENAMEFMT = '文件格式无效...';
err_NOFILEEXIST = '文件 %s 没有找到.';
err_COMPRESS = '数据库压缩失败.';
err_REPAIR = '数据库修复失败.';
err_RENAME = '重新命名错误' + #13 + '压缩后的数据库文件为：tmpData.mdb';
err_CREATE = '创建数据库失败...';
tmp_FILE = 'tmpData.mdb';
hnt_SELSRCFILE = '<Double click select source file>';
hnt_SELDESFILE = '<Double click select destination file>';

dbt_DBASEIII = 'dBase III;';

lnk_ADOCONN_STR ='Provider=Microsoft.Jet.OLEDB.4.0;Data Source=%S;Persist Security Info=False;Jet OLEDBatabase Password=%s';
exp_SQLTEXT = 'SELECT * INTO %S IN "%S" "%S" FROM %S';

type
TTransferType = (ttExport,ttImport);
TDriverName = (Microsoft_Access,
Jet_2x,
Jet_3x,
dBase_III,
dBbase_IV,
dBase_5,
Paradox_3x,
Paradox_4x,
Paradox_5x,
Paradox_7x,
ODBC);

TFileNameProperty = class(TStringProperty)
private

protected

public
procedure Edit; override;
published

end;

TmsAccessTools = class(TComponent)
private
FsrcFileName: string;
FPassword: string;
FdesFileName: string;
FDriverName: TDriverName;
FTransferType: TTransferType;
FTableName: string;
function CheckFileName: boolean;
procedure HintMsgBox(Text: string; Caption: string = 'MS ACCESS 数据库');
procedure SetDriverName(const Value: TDriverName);
procedure SetdesFileName(const Value: string);
procedure SetPassword(const Value: string);
procedure SetsrcFileName(const Value: string);
procedure SetTransferType(const Value: TTransferType);
procedure SetTableName(const Value: string);
function VerifierTableName(TableName: string; TablesName: TStringList): boolean;
procedure GetFileInfo(FileName: string; var fPath, fName: string);
protected
ADOConnection: TADOConnection;
MDBTables: TStringList;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;

function CompressDatabase: boolean; //压缩MSACCESS数据库
function RepairDatabase: boolean; //修复MSACCESS数据库
function CreateDatabase97: boolean; //创建MSACCESS97数据库
function CreateDatabase2000: boolean; //创建MSACCESS2000数据库
function CreateLinkTable: boolean; //创建链接表
function TransferDatabase: boolean; //转移ACCESS数据库
published
property srcFileName: string read FsrcFileName write SetsrcFileName;
property desFileName: string read FdesFileName write SetdesFileName;
property TableName: string read FTableName write SetTableName;
property Password: string read FPassword write SetPassword;
property DriverName: TDriverName read FDriverName write SetDriverName;
property TransferType: TTransferType read FTransferType write SetTransferType;
end;


procedure Register;

implementation

procedure Register;
begin
RegisterPropertyEditor(TypeInfo(String),TMsAccessTools,'srcFileName',TFileNameProperty);
RegisterPropertyEditor(TypeInfo(String),TMsAccessTools,'desFileName',TFileNameProperty);
RegisterComponents('EastRich', [TMsAccessTools]);
end;

{ TMsAccessTools }

function TMsAccessTools.CheckFileName: boolean;
begin
Result := False;
if FsrcFileName = '' then
begin
HintMsgBox(err_NOFILENAME);
Exit
end else
if Pos('.MDB',UpperCase(FsrcFileName)) = 0 then
begin
HintMsgBox(err_FILENAMEFMT);
Exit;
end else
if not FileExists(FsrcFileName) then
begin
HintMsgBox(Format(err_NOFILEEXIST,[FsrcFileName]));
Exit;
end;
Result := True;
end;

function TMsAccessTools.CompressDatabase: boolean;
var
ADOMDB: OLEVariant;
begin
Result := True;
if CheckFileName then
begin
ADOMDB := CreateOleObject('DAO.DBEngine.35');
try
ADOMDB.CompactDatabase(FsrcFileName, tmp_FILE);
except
ADOMDB := CreateOleObject('DAO.DBEngine.36');
try
ADOMDB.CompactDatabase(FsrcFileName, tmp_FILE);
except
HintMsgBox(err_COMPRESS);
Result := False;
end;
end;
try
DeleteFile(FsrcFileName);
RenameFile(tmp_FILE,FsrcFileName);
except
HintMsgBox(err_RENAME);
Result := False;
end;
end;
end;

function TMsAccessTools.RepairDatabase: boolean;
var
ADOMDB: OLEVariant;
begin
Result := True;
if CheckFileName then
begin
ADOMDB := CreateOleObject('DAO.DBEngine.35');
try
ADOMDB.RepairDatabase(FsrcFileName);
except
ADOMDB := CreateOleObject('DAO.DBEngine.36');
try
ADOMDB.RepairDatabase(FsrcFileName);
except
HintMsgBox(err_REPAIR);
Result := False;
end;
end;
end;
end;

procedure TMsAccessTools.HintMsgBox(Text, Caption: string);
begin
Application.MessageBox(PChar(Text), PChar(Caption), MB_OK+MB_ICONINFORMATION);
end;

function TMsAccessTools.CreateDatabase97: boolean;
var
EngineBEngine;
begin
Result := True;
Engine := CoDBEngine.Create;
try
Engine.CreateDatabase(FsrcFileName,';LANGID=0x0804;CP=936;COUNTRY=0;',dbEncrypt);
except
HintMsgBox(err_CREATE);
Result := False;
end;
end;

function TMsAccessTools.CreateDatabase2000: boolean;
var
CreateAccess: OleVariant;
begin
Result := True;
CreateAccess := CreateOleObject('ADOX.Catalog');
try
if FPassword <> '' then
CreateAccess.Create(Format('Provider=Microsoft.Jet.OLEDB.4.0;Data Source=%s;Jet OLEDBatabase Password=%s',[FsrcFileName,FPassword]))
else
CreateAccess.Create(Format('Provider=Microsoft.Jet.OLEDB.4.0;Data Source=%s',[FsrcFileName]));
except
HintMsgBox(err_CREATE);
Result := False;
end;
end;

constructor TMsAccessTools.Create(AOwner: TComponent);
begin
inherited;
DriverName := dBase_III;
ADOConnection := TADOConnection.Create(Self);
ADOConnection.LoginPrompt := False;
MDBTables := TStringList.Create;
srcFileName := hnt_SELSRCFILE;
desFileName := hnt_SELDESFILE;
end;

destructor TMsAccessTools.Destroy;
begin
MDBTables.Free;
ADOConnection.Free;
inherited;
end;

function TMsAccessTools.TransferDatabase: boolean;
var
fPath, fName,aaa: string;
begin
with ADOConnection do
if FileExists(FsrcFileName)and(FsrcFileName <> '')and(FdesFileName <> '') then
begin
ConnectionString := Format(lnk_ADOCONN_STR, [FsrcFileName, FPassword]);
try
MDBTables.Clear;
GetTableNames(MDBTables);
GetFileInfo(FdesFileName,fPath, fName);
aaa := Format(exp_SQLTEXT,[fName, fPath, dbt_DBASEIII, FTableName]);
if VerifierTableName(FTableName, MDBTables) then
case FDriverName of
dBase_III: Execute(aaa);
end;
Result := True;
except
Result := False;
end;
end;
end;


procedure TMsAccessTools.SetDriverName(const Value: TDriverName);
begin
FDriverName := Value;
end;

procedure TMsAccessTools.SetdesFileName(const Value: string);
begin
FdesFileName := Value;
end;

procedure TMsAccessTools.SetPassword(const Value: string);
begin
FPassword := Value;
end;

procedure TMsAccessTools.SetsrcFileName(const Value: string);
begin
FsrcFileName := Value;
end;

procedure TMsAccessTools.SetTransferType(const Value: TTransferType);
begin
FTransferType := Value;
end;

procedure TMsAccessTools.SetTableName(const Value: string);
begin
FTableName := Value;
end;

function TMsAccessTools.VerifierTableName(TableName: string;
TablesName: TStringList): boolean;
var
i: integer;
begin
for i := 0 to TablesName.Count - 1 do
begin
Result := TablesName.Strings = TableName;
if Result then Break;
end;
end;

procedure TMsAccessTools.GetFileInfo(FileName: string; var fPath, fName: string);
var
Len, i: integer;
begin
Len := Length(FileName);
for i := Len downto 0 do
if FileName = '/' then Break;
fPath := Copy(FileName, 1, i);
fName := Copy(FileName, i + 1, Len - i);
end;

function TmsAccessTools.CreateLinkTable: boolean;
var
adox_Catalog, adox_Table: OleVariant;
LinkTableName: string;

begin
Result := True;
//打开链接的要连接到的数据库，即主数据库
{ adox_Catalog := CreateOleObject('ADOX.Catalog');
adox_Catalog.ActiveConnection := Format('Provider=Microsoft.Jet.OLEDB.4.0;Data Source=%S',[LinkPath + 'Data/ArmyInfo.mdb']);;

Share.SelectSQL(dm_AGDB.adoqry_Code, 'SELECT CXMC FROM CODELIST');
with dm_AGDB.adoqry_Code do
begin
First;
while not Eof do
begin
LinkTableName := FieldByName('CXMC').AsString;
adox_Table := CreateOleObject('ADOX.Table');
adox_Table.Name := LinkTableName;//链接后的表的名称

//指出链接表的信息
adox_Table.ParentCatalog := adox_Catalog;
adox_Table.Properties('Jet OLEDB:Remote Table Name') := LinkTableName;
adox_Table.Properties('Jet OLEDB:Link Datasource') := LinkPath + 'Data/ArmyCode.mdb';
try
adox_Table.Properties('Jet OLEDB:Create Link') := True;
//进行链接操作
adox_Catalog.Tables.Append(adox_Table);
Next;
except
Result := False;
Exit;
end;
end;
end;}
end;

{ TFileNameProperty }

procedure TFileNameProperty.Edit;
var
OpenDialog: TOpenDialog;
begin
OpenDialog := TOpenDialog.Create(Application);
try
// OpenDialog.FileName := GetStrValue;
if OpenDialog.Execute then
SetStrValue(OpenDialog.FileName);
finally
OpenDialog.Free;
end;
end;


end.

{************************ end of file *******************************}

不錯，已收藏。
ego能否给我一份呢？多谢。lyaip@etang.com

崔占东：我的Eail---chenghm_boy@163.net或hmchen@fiberhome.com.cn
请把你做的控件发给我！谢了先！

ego能否给我一份呢？多谢。
love51@163.com

好东西哦。copy了
ego能给我一份吗？ 谢谢 c20082263.net