📄 unit1.pas
字号:
procedure TForm1.FileListBox3Click(Sender: TObject);
var
cf:string;
begin
{============================================}
if FileListBox3.FileName<>'' then
begin
cf:=FileListBox3.FileName;
{==================}
Archiver1.Close;
Archiver1.ExtractPath:=ExtractFilePath(cf);
Archiver1.FileName:= cf;
deletefile(ExtractFilePath(cf)+'tmp.tmp');
editor.Clear;
Archiver1.RestoreAction := raOverwrite;
try
Archiver1.ExtractFiles;
except
end;
editor.Lines.LoadFromFile(ExtractFilePath(cf)+'tmp.tmp');
form1.Caption:=deptname.Caption+'-文档资料信息接收系统-'+ExtractFileName(cf);
Label1.Caption:='类别:'+combobox1.Text+' 文件名: ' + ExtractFileName(cf);
end;
{===============================================}
end;
procedure TForm1.Archiver1DeleteFile(Sender: TObject;
const FileEntry: TFileEntry; var Accept: Boolean);
begin
accept:=true;
end;
procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
LMD3PaneSplitCtrl1.Splitter2.Position:=0;
X1.Checked:=true;
N40.Checked:=false;
end;
procedure TForm1.PopupMenu4Popup(Sender: TObject);
begin
if trim(FileListBox3.FileName)='' then
begin
n36.Enabled:=false;
n37.Enabled:=false;
end else
begin
n36.Enabled:=true;
n37.Enabled:=true;
end;
end;
procedure TForm1.SpeedButton2Click(Sender: TObject);
begin
LMD3PaneSplitCtrl1.Splitter2.Position:=161;
X1.Checked:=false;
N40.Checked:=true;
end;
procedure TForm1.N37Click(Sender: TObject);
var
ret:integer;
i:integer;
y:word;
m:word;
d:word;
begin
DecodeDate(DateTimePicker2.date,y,m,d);
if filelistbox3.FileName<>'' then
begin
ret:=application.MessageBox(pchar('真的要删除你所选择的数据报表?, 删除后将不可恢复?'),'删除数据报表',MB_OKCANCEL+MB_DEFBUTTON2+MB_ICONQUESTION);
if ret=1 then
begin
for i:=0 to filelistbox3.Items.Count-1 do
begin
if filelistbox3.Selected[i] then
begin
// showmessage(DirectoryListBox1.Directory+'\'+filelistbox1.Items.Strings[i]);
Archiver1.Close;
DeleteFile(dir+'\dat\temp0'+inttostr(ComboBox1.ItemIndex)+'\'+filelistbox3.Items.Strings[i]);
end;
end;
filelistbox3.Update;
end;
end;
end;
procedure TForm1.DateTimePicker2Change(Sender: TObject);
var
y:word;
m:word;
d:word;
begin
DecodeDate(DateTimePicker2.date,y,m,d);
forcedirectories(dir+'\dat\rdx0'+inttostr(form1.ComboBox1.ItemIndex)+'\'+form1.ComboBox1.Text+inttostr(y)+inttostr(m)+inttostr(d));
LsFileListView1.Directory:=dir+'\dat\rdx0'+inttostr(form1.ComboBox1.ItemIndex)+'\'+form1.ComboBox1.Text+inttostr(y)+inttostr(m)+inttostr(d);
end;
procedure TForm1.N36Click(Sender: TObject);
var
i:integer ;
ret:integer;
y:word;
m:word;
d:word;
begin
DecodeDate(DateTimePicker2.date,y,m,d);
{=================================}
ret:=application.MessageBox(pchar('确定要把你选择的数据导入此文件夹内,如果此文件内有和你将导入相重名的文件，将被过写?'),'确定导入',MB_OKCANCEL+MB_DEFBUTTON2+MB_ICONQUESTION);
if ret=1 then
begin
Archiver1.Close;
for i:=0 to form1.filelistbox3.Items.Count-1 do
begin
if form1.filelistbox3.Selected[i] then
begin
try
deletefile(dir+'\dat\rdx0'+inttostr(form1.ComboBox1.ItemIndex)+'\'+form1.ComboBox1.Text+inttostr(y)+inttostr(m)+inttostr(d)+'\'+form1.filelistbox3.Items.Strings[i]);
copyfile(pchar(dir+'\dat\temp0'+inttostr(ComboBox1.ItemIndex)+'\'+filelistbox3.Items.Strings[i]),pchar(dir+'\dat\rdx0'+inttostr(form1.ComboBox1.ItemIndex)+'\'+form1.ComboBox1.Text+inttostr(y)+inttostr(m)+inttostr(d)+'\'+form1.filelistbox3.Items.Strings[i]),false);
DeleteFile(dir+'\dat\temp0'+inttostr(ComboBox1.ItemIndex)+'\'+filelistbox3.Items.Strings[i]);
LsFileListView1.UpdateFileList;
except
end;
end;
end;
form1.filelistbox3.Update;
end;
{===============================================}
end;
procedure TForm1.SpeedButton4Click(Sender: TObject);
begin
LsFileListView1.DeleteFiles;
end;
procedure TForm1.LsFileListView1DblClick(Sender: TObject);
var
ret:integer;
begin
if LsFileListView1.FileName<>'' then
begin
try
if executefile(LsFileListView1.FileName,'','',1)=31 then
begin
showmessage ('此文件不是可执行文件，或者它没有注册关联文档');
end;
except
end;
end;
{ret:=application.MessageBox(pchar('确定要把文件 '+ExtractFileName(LsFileListView1.FileName)+' 导出,如果此文件内有和你将导出相重名的文件，将被过写?'),'确定导出',MB_OKCANCEL+MB_DEFBUTTON2+MB_ICONQUESTION);
if ret=1 then
begin
Archiver1.Close;
try
deletefile(dir+'\dat\temp0'+inttostr(form1.ComboBox1.ItemIndex)+'\'+ExtractFileName(LsFileListView1.FileName));
copyfile(pchar(LsFileListView1.FileName),pchar(dir+'\dat\temp0'+inttostr(form1.ComboBox1.ItemIndex)+'\'+ExtractFileName(LsFileListView1.FileName)),false);
DeleteFile(LsFileListView1.FileName);
LsFileListView1.UpdateFileList;
LsFileListView1.FileName:='';
except
LsFileListView1.FileName:='';
end;
form1.filelistbox3.Update;
end; }
{==================================================================================}
end;
procedure TForm1.SpeedButton11Click(Sender: TObject);
begin
N32.Click;
end;
procedure TForm1.N28Click(Sender: TObject);
begin
if SpeedButton7.enabled then SpeedButton13Click(nil);
end;
procedure TForm1.MenuItem7Click(Sender: TObject);
begin
SendbtClick(nil);
end;
procedure TForm1.MenuItem2Click(Sender: TObject);
begin
StatusBar1.Visible:= not StatusBar1.Visible;
end;
procedure TForm1.X1Click(Sender: TObject);
begin
SpeedButton1Click(nil);
end;
procedure TForm1.N40Click(Sender: TObject);
begin
SpeedButton2Click(nil);
end;
procedure TForm1.MenuItem4Click(Sender: TObject);
begin
close;
end;
procedure TForm1.MenuItem5Click(Sender: TObject);
begin
LsFileListView1DblClick(nil);
end;
procedure TForm1.MenuItem8Click(Sender: TObject);
begin
SpeedButton4Click(nil);
end;
procedure TForm1.SpeedButton3Click(Sender: TObject);
begin
LsFileListView1.ViewStyle:=vsIcon;
end;
procedure TForm1.SpeedButton5Click(Sender: TObject);
begin
LsFileListView1.ViewStyle:=vsReport;
end;
procedure TForm1.SpeedButton6Click(Sender: TObject);
begin
LsFileListView1.ViewStyle:=vslist;
end;
procedure TForm1.InitSyaDat;
begin
try
if not fileexists('C:\NewStar\Enterpirse\user\sysuser.dat') then
begin
fileexist.Caption:='error';
exit;
end;
ClientDataSet2.Close;
ClientDataSet2.LoadFromFile('C:\NewStar\Enterpirse\user\sysuser.dat');
ClientDataSet2.Open;
ClientDataSet2.First;
while not ClientDataSet2.EOF do
begin
if ClientDataSet2.fieldbyname('local').Value=true then
begin
{===========================================================================}
nameLabel.Caption:=ClientDataSet2.fieldbyname('ycjsjm').asstring;
superLabel.Caption:=ClientDataSet2.fieldbyname('super').asstring;
localLabel.Caption:=ClientDataSet2.fieldbyname('local').asstring;
registryLabel.Caption:=ClientDataSet2.fieldbyname('registry').asstring;
hostsiteLabel.Caption:=ClientDataSet2.fieldbyname('hostsite').asstring;
ftppassLabel.Caption:=ClientDataSet2.fieldbyname('ftppass').asstring;
ftpuserLabel.Caption:=ClientDataSet2.fieldbyname('ftpuser').asstring;
datpassLabel.Caption:=ClientDataSet2.fieldbyname('datpass').asstring;
dbuserLabel.Caption:=ClientDataSet2.fieldbyname('dbuser').asstring;
dbpassLabel.Caption:=ClientDataSet2.fieldbyname('dbpass').asstring;
datuserLabel.Caption:=ClientDataSet2.fieldbyname('datuser').asstring;
skyjyLabel.Caption:=ClientDataSet2.fieldbyname('skyjy').asstring;
skyfsjyLabel.Caption:=ClientDataSet2.fieldbyname('skyfsjy').asstring;
skydqjyLabel.Caption:=ClientDataSet2.fieldbyname('skydqjy').asstring;
skyeditorjyLabel.Caption:=ClientDataSet2.fieldbyname('skyeditorjy').asstring;
skyeditorjsjyLabel.Caption:=ClientDataSet2.fieldbyname('skyeditorjsjy').asstring;
skyeditorfsjyLabel.Caption:=ClientDataSet2.fieldbyname('skyeditorfsjy').asstring;
skyeditortjjyLabel.Caption:=ClientDataSet2.fieldbyname('skyeditortjjy').asstring;
skynetjyLabel.Caption:=ClientDataSet2.fieldbyname('skynetjy').asstring;
SkyServerjyLabel.Caption:=ClientDataSet2.fieldbyname('SkyServerjy').asstring;
SkyServer01jyLabel.Caption:=ClientDataSet2.fieldbyname('SkyServer01jy').asstring;
SkyServer02jyLabel.Caption:=ClientDataSet2.fieldbyname('SkyServer02jy').asstring;
SkyServer03jyLabel.Caption:=ClientDataSet2.fieldbyname('SkyServer03jy').asstring;
SkyServer04jyLabel.Caption:=ClientDataSet2.fieldbyname('SkyServer04jy').asstring;
SkyServer05jyLabel.Caption:=ClientDataSet2.fieldbyname('SkyServer05jy').asstring;
SkyServer06jyLabel.Caption:=ClientDataSet2.fieldbyname('SkyServer06jy').asstring;
EditorServerjyLabel.Caption:=ClientDataSet2.fieldbyname('EditorServerjy').asstring;
ftpjylabel.Caption:=ClientDataSet2.fieldbyname('ftpjy').asstring;
ftpszjylabel.Caption:=ClientDataSet2.fieldbyname('ftpszjy').asstring;
ftpxjwjjjylabel.Caption:=ClientDataSet2.fieldbyname('ftpxjwjjjy').asstring;
ftpxzjylabel.Caption:=ClientDataSet2.fieldbyname('ftpxzjy').asstring;
ftpscjylabel.Caption:=ClientDataSet2.fieldbyname('ftpscjy').asstring;
sqljy.Caption:=ClientDataSet2.fieldbyname('sqljy').asstring;
nssqljy.Caption:=ClientDataSet2.fieldbyname('nssqljy').asstring;
WinArchiverjyLabel.Caption:=ClientDataSet2.fieldbyname('WinArchiverjy').asstring;
WinFtpJyLabel.Caption:=ClientDataSet2.fieldbyname('WinFtpJy').asstring;
SkyImagejyLabel.Caption:=ClientDataSet2.fieldbyname('SkyImagejy').asstring;
exit;
end;
ClientDataSet2.Next;
end;
{===========================================================================}
except
readsysdat.Caption:='error';
end;
end;
procedure TForm1.FormActivate(Sender: TObject);
begin
if uppercase(trim(fileexist.Caption))='ERROR' then
begin
showmessage('系统检测到本远程计算机未安装完整,请安装完整!');
close;
end;
if uppercase(trim(registryLabel.Caption))<>'TRUE' then
begin
showmessage('系统检测到本远程计算机还未注册,请注册后使用!');
close;
end;
if uppercase(trim(readsysdat.Caption))='ERROR' then
begin
showmessage('系统读取本远程计算机系统数据库出现意外错误!,请重试!');
close;
end;
if Uppercase(EditorServerjyLabel.Caption)='TRUE' then
begin
showmessage('系统检测到你没有此权限使用此功能!');
close;
end;
end;
procedure TForm1.LsFileListView1MouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if Button=mbRight then PopupMenu2.Popup(form1.left+FileListBox3.width+x,form1.top+LMD3PaneSplitCtrl1.Top+71+y);
end;
procedure TForm1.PopupMenu2Popup(Sender: TObject);
begin
if LsFileListView1.SelectedNumber<>0 then
begin
N43241.Enabled:=true;
N1.Enabled:=true;
end else
begin
N43241.Enabled:=false;
N1.Enabled:=false;
end;
end;
procedure TForm1.N43241Click(Sender: TObject);
begin
LsFileListView1.DeleteFiles;
end;
procedure TForm1.MenuItem1Click(Sender: TObject);
begin
Toolbar971.Show;
end;
procedure TForm1.G1Click(Sender: TObject);
begin
n28.enabled:=SpeedButton7.Enabled;
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -