📄 unit1.pas
字号:
if clientdataset1.FieldDefs.Items[i].DataType =ftdate then
begin
{ filetype.Lines.Add('ftdate');}
table1.FieldDefs.Add(clientdataset1.FieldDefs.Items[i].Name,ftdate, 0,false);
end;
if clientdataset1.FieldDefs.Items[i].DataType =ftword then
begin
{filetype.Lines.Add('ftword');}
table1.FieldDefs.Add(clientdataset1.FieldDefs.Items[i].Name ,ftword, 0,false);
end;
if clientdataset1.FieldDefs.Items[i].DataType =ftinteger then
begin
table1.FieldDefs.Add( clientdataset1.FieldDefs.Items[i].Name,ftinteger,0,false);
{filetype.Lines.Add('ftinteger');}
end;
if clientdataset1.FieldDefs.Items[i].DataType =ftfloat then
begin
table1.FieldDefs.Add( clientdataset1.FieldDefs.Items[i].Name,ftfloat,0,false);
{ filetype.Lines.Add('ftfloat'); }
end;
if clientdataset1.FieldDefs.Items[i].DataType =ftboolean then
begin
table1.FieldDefs.Add( clientdataset1.FieldDefs.Items[i].Name,ftboolean,0,false);
{ filetype.Lines.Add('ftboolean');}
end;
if clientdataset1.FieldDefs.Items[i].DataType =fttime then
begin
table1.FieldDefs.Add( clientdataset1.FieldDefs.Items[i].Name,fttime,0,false);
{ filetype.Lines.Add('fttime'); }
end;
if clientdataset1.FieldDefs.Items[i].DataType =ftautoinc then
begin
table1.FieldDefs.Add( clientdataset1.FieldDefs.Items[i].Name,ftautoinc,0,false);
{ filetype.Lines.Add('ftautoinc');}
end;
if clientdataset1.FieldDefs.Items[i].DataType =ftcurrency then
begin
table1.FieldDefs.Add( clientdataset1.FieldDefs.Items[i].Name,ftcurrency,0,false);
{ filetype.Lines.Add('ftcurrency'); }
end;
if clientdataset1.FieldDefs.Items[i].DataType =ftmemo then
begin
table1.FieldDefs.Add( clientdataset1.FieldDefs.Items[i].Name,ftmemo,word(clientdataset1.Fields[i].DisplayWidth),false);
{ filetype.Lines.Add('ftmemo');}
end;
if clientdataset1.FieldDefs.Items[i].DataType =ftstring then
begin
table1.FieldDefs.Add( clientdataset1.FieldDefs.Items[i].Name,ftstring,word(clientdataset1.Fields[i].DisplayWidth),false);
{ filetype.Lines.Add('ftstring'); }
end;
if clientdataset1.FieldDefs.Items[i].DataType =ftbcd then
begin
table1.FieldDefs.Add( clientdataset1.FieldDefs.Items[i].Name,ftbcd,word(clientdataset1.Fields[i].DisplayWidth),false);
{ filetype.Lines.Add('ftbcd');}
end;
if clientdataset1.FieldDefs.Items[i].DataType =ftblob then
begin
table1.FieldDefs.Add( clientdataset1.FieldDefs.Items[i].Name,ftblob,word(clientdataset1.Fields[i].DisplayWidth),false);
{ filetype.Lines.Add('ftblob'); }
end;
{ filename.Lines.Add( clientdataset1.FieldDefs.Items[i].Name);}
{ filesize.Lines.Add( inttostr(clientdataset1.Fields[i].DisplayWidth));}
end;
chdir(dir);
deletefile('temp.dbf');
table1.TableName:='temp.dbf';
table1.Createtable;
table1.Open;
clientdataset1.First;
while not clientdataset1.EOF do
begin
table1.Edit;
table1.Append;
for i:=0 to clientdataset1.FieldDefs.Count-1 do
begin
table1.FieldByName(clientdataset1.FieldDefs.Items[i].Name ).Value:=clientdataset1.FieldByName(clientdataset1.FieldDefs.Items[i].Name ).Value;
end;
table1.Post;
clientdataset1.Next;
end;
table1.Close;
table1.Open;
BatchMove1.Destination:=table2;
BatchMove1.Source:=table1;
BatchMove1.Mode:=batAppend;
BatchMove1.Execute;
end;
procedure TForm1.BitBtn1Click(Sender: TObject);
var i: integer;
ret:integer;
begin
append;
ProgressBar1.Position:=0;
ret:=application.MessageBox(pchar('数据已成功追加,是否要删除原CDX文件?'),'追加数据记录',MB_OKCANCEL+MB_DEFBUTTON2+MB_ICONQUESTION);
if ret=1 then
begin
for i:=0 to filelistbox1.Items.Count-1 do
begin
deletefile(DirectoryListBox1.Directory+'\'+FileListBox1.Items.Strings[i]);
end;
end;
filelistbox1.Update;
panel10.Visible:=false;
panel11.Visible:=false;
end;
procedure TForm1.BitBtn9Click(Sender: TObject);
begin
panel10.Visible:=false;
panel11.Visible:=false;
end;
procedure TForm1.N1Click(Sender: TObject);
var
ret:integer;
begin
if FileListBox2.FileName<>'' then
begin
ret:=application.MessageBox(pchar('确定要将你所选的数据表'+filelistbox2.FileName+'追加到服务器上吗? '+filelistbox2.FileName+'被追加到服务器后，此表格将要被清空...'),'追加数据记录',MB_OKCANCEL+MB_DEFBUTTON2+MB_ICONQUESTION);
if ret=1 then
begin
form2 := Tform2.Create( Application );
try
form2.Show;
form2.Update;
except
end;
end;
end;
end;
procedure TForm1.SpeedButton6Click(Sender: TObject);
begin
if filelistbox1.FileName<>'' then
begin
ClientDataSet1.SaveToFile(FileListBox1.FileName);
end;
end;
procedure TForm1.SpeedButton4Click(Sender: TObject);
var
i:integer;
j:integer;
C:string;
begin
if not ClientDataSet1.IsEmpty then
begin
try
MsExcel:=CreateOleObject('Excel.Application');
MsExcelWorkBook:=MsExcel.WorkBooks.Add;
MsExcelWorkSheet:=MsExcel.WorkSheets.Add;
except
MessageDlg('启动Excel 97出现异常！！请检查你的机器内是否安装OFFICE？',mtWarning,[mbOK],0);
exit;
end;
MsExcel.Visible:=True;
{+========================================+}
ClientDataSet1.First;
J:=0;
WHILE NOT ClientDataSet1.EOF DO
begin
J:=j+1;
for i:=0 to ClientDataSet1.FieldCount-1 do
begin
if i=0 then C:='A';
if i=1 then C:='B';
if i=2 then C:='C';
if i=3 then C:='D';
if i=4 then C:='E';
if i=5 then C:='F';
if i=6 then C:='G';
if i=7 then C:='H';
if i=8 then C:='I';
if i=9 then C:='J';
if i=10 then C:='K';
if i=11 then C:='L';
if i=12 then C:='M';
if i=13 then C:='N';
if i=14 then C:='O';
if i=15 then C:='P';
if i=16 then C:='K';
if i=17 then C:='R';
if i=18 then C:='S';
if i=19 then C:='T';
if i=20 then C:='U';
if i=21 then C:='V';
if i=22 then C:='W';
if i=23 then C:='X';
if i=24 then C:='Y';
if i=25 then C:='Z';
if i=26 then C:='AA';
if i=27 then C:='AB';
if i=28 then C:='AC';
if i=29 then C:='AD';
if i=30 then C:='AE';
if i=31 then C:='AF';
if i=32 then C:='AG';
if i=33 then C:='AH';
if i=34 then C:='AI';
if i=35 then C:='AJ';
if i=36 then C:='AK';
if i=37 then C:='AL';
if i=38 then C:='AM';
if i=39 then C:='AN';
if i=40 then C:='AO';
if i=41 then C:='AP';
if i=42 then C:='AK';
if i=43 then C:='AR';
if i=44 then C:='AS';
if i=45 then C:='AT';
if i=46 then C:='AU';
if i=47 then C:='AV';
if i=48 then C:='AW';
if i=49 then C:='AX';
if i=50 then C:='AY';
if i=51 then C:='AZ';
MsExcelWorkSheet.Range[C+IntToStr(J)].Value:=ClientDataSet1.Fields[i].AsString ;
end;
ClientDataSet1.Next;
end;
{+================================================+}
try
deletefile(form1.DirectoryListBox4.Directory+'\显示结果.XLS');
MsExcelWorkSheet.SaveAs(form1.DirectoryListBox4.Directory+'\显示结果.XLS');
except
MessageDlg('无法保存 '+form1.DirectoryListBox4.Directory+'\显示结果.XLS',mtInformation,[mbOK],0);
end;
end
else
begin
showmessage('系统已经检测到你想用EXCEL观看的数据库还没有数据，请先录入数据在用它观看...');
end;
end;
procedure TForm1.DataSource2DataChange(Sender: TObject; Field: TField);
begin
StatusBar1.Panels[1].text:=inttostr(table2.RecNo);
end;
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
{
if Directoryexists('d:\') then
begin
try
if not Directoryexists('D:\备份文件\') then
begin
forceDirectories('D:\备份文件\');
end;
except
end;
s:= 'D:\备份文件\';
end else
begin
try
if not Directoryexists('C:\备份文件\') then
begin
forceDirectories('C:\备份文件\');
end;
except
end;
s:= 'c:\备份文件\';
end;
if uppercase(trim(registryLabel.Caption))<>'TRUE' then exit;
if uppercase(trim(fileexist.Caption))='ERROR' then exit;
if uppercase(trim(registryLabel.Caption))<>'TRUE' then exit;
if uppercase(trim(readsysdat.Caption))='ERROR' then exit;
if Uppercase(skyServerjyLabel.Caption)='TRUE' then exit;
ret:=application.MessageBox(pchar('为了防止病毒的影响,系统将将《@NewStar Co Ltd信息服务器接收系统》重要文件备份在: '+ s+' 的目录文件夹内...是否备份?'),'备份数据',MB_OKCANCEL+MB_DEFBUTTON2+MB_ICONQUESTION);
if ret=1 then
begin
end else
begin
exit;
end;
with FlyingOp1 do
begin
SourceDirectory := 'c:\Skyworth\';
DestinationDirectory :=s+'Skyworth\' ;
RecurseDirectory := true;
FileMask :='*.*';
SearchForFiles;
ExecCopy;
end;
}
end;
procedure TForm1.N2Click(Sender: TObject);
var
ret:integer;
begin
if FileListBox2.FileName<>'' then
begin
begin
form5 := Tform5.Create( Application );
try
form5.Show;
form5.Update;
form5.Memo1.Lines.Clear;
form5.Memo1.Lines.Add('原数据表名为: '+filelistbox2.FileName);
form5.edit1.Text:=ExtractFileName(filelistbox2.FileName);
except
end;
end;
end;
end;
procedure TForm1.N3Click(Sender: TObject);
begin
form8:= Tform8.Create( Application );
try
form8.Show;
form8.Update;
except
end;
end;
procedure TForm1.N4Click(Sender: TObject);
var
ret:integer;
begin
if FileListBox2.FileName<>'' then
begin
ret:=application.MessageBox(pchar('确定要将你所选的数据表'+filelistbox2.FileName+'删除吗?...'),'删除数据表',MB_OKCANCEL+MB_DEFBUTTON2+MB_ICONQUESTION);
if ret=1 then
begin
table2.Close;
deletefile( FileListBox2.FileName);
FileListBox2.Update;
end;
end;
end;
procedure TForm1.N6Click(Sender: TObject);
var
ret:integer;
i:integer;
begin
if filelistbox1.FileName<>'' then
begin
ret:=application.MessageBox(pchar('真的要删除你所选择的数据报表?, 删除后将不可恢复?'),'删除数据报表',MB_OKCANCEL+MB_DEFBUTTON2+MB_ICONQUESTION);
if ret=1 then
begin
// if filelistbox1.Selected=nil then Exit;
ClientDataSet1.Close;
for i:=0 to filelistbox1.Items.Count-1 do
begin
if filelistbox1.Selected[i] then
begin
// showmessage(DirectoryListBox1.Directory+'\'+filelistbox1.Items.Strings[i]);
DeleteFile(DirectoryListBox1.Directory+'\'+filelistbox1.Items.Strings[i]);
end;
end;
filelistbox1.Update;
end;
end;
end;
procedure TForm1.SpeedButton7Click(Sender: TObject);
begin
if not ClientDataSet1.IsEmpty then
ClientDataSet1.First;
end;
procedure TForm1.SpeedButton8Click(Sender: TObject);
begin
if not ClientDataSet1.IsEmpty then
ClientDataSet1.Last;
end;
procedure TForm1.SpeedButton9Click(Sender: TObject);
var
ret:integer;
begin
ret:=application.MessageBox('真的要删除本条记录?','删除记录',MB_OKCANCEL+MB_DEFBUTTON2+MB_ICONQUESTION);
if ret=1 then
begin
if not ClientDataSet1.IsEmpty then
ClientDataSet1.Delete;
end;
end;
procedure TForm1.N7Click(Sender: TObject);
begin
SpeedButton9.Click;
end;
procedure TForm1.N16Click(Sender: TObject);
begin
SpeedButton6.Click
end;
procedure TForm1.N24Click(Sender: TObject);
var
C:variant;
begin
c:=ClientDataSet1.Fields[DBGriD1.SelectedIndex].Value;
while not ClientDataSet1.EOF do
begin
ClientDataSet1.Edit;
ClientDataSet1.Fields[DBGriD1.SelectedIndex].Value:=c;
ClientDataSet1.Next;
end;
end;
procedure TForm1.N25Click(Sender: TObject);
var
C:variant;
begin
while not ClientDataSet1.EOF do
begin
ClientDataSet1.Edit;
ClientDataSet1.Fields[DBGriD1.SelectedIndex].Value:=c;
ClientDataSet1.Next;
end;
end;
procedure TForm1.FileListBox2Click(Sender: TObject);
begin
TabbedNotebook1.ActivePage:=' 目标数据库 ';
if filelistbox2.FileName<>'' then
begin
table2.Close;
table2.DatabaseName:='';
table2.TableName:=filelistbox2.FileName;
table2.Open;
end;
end;
procedure TForm1.SpeedButton16Click(Sender: TObject);
begin
if (ComboBox1.ItemIndex+1)=1 then
begin
if Uppercase(skyServer01jyLabel.Caption)='TRUE' then
begin
showmessage('系统检测到你没有此权限使用此功能!');
exit;
end;
end;
BitBtn3.Click;
end;
procedure TForm1.SpeedButton17Click(Sender: TObject);
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -