编了一个网络备份的程序,老是出现警告,程序执行也有问题,请帮忙看看(100分)

  • 主题发起人 主题发起人 shp1997
  • 开始时间 开始时间
S

shp1997

Unregistered / Unconfirmed
GUEST, unregistred user!
unit TEST;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Grids, DBGrids, DB, DBTables, StdCtrls, ComCtrls, Menus,
ExtCtrls, DBCtrls;

type
TForm1 = class(TForm)
Table1: TTable;
DataSource1: TDataSource;
DBGrid1: TDBGrid;
StatusBar1: TStatusBar;
ProgressBar1: TProgressBar;
Button1: TButton;
Button2: TButton;
ListBox1: TListBox;
Label1: TLabel;
Label2: TLabel;
ComboBox1: TComboBox;
Table1DM: TStringField;
Table1MC: TStringField;
Table1IP: TStringField;
Table1IP_PATH: TStringField;
Table1F_PATH: TStringField;
Edit1: TEdit;
procedure Button2Click(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure DBGrid1DblClick(Sender: TObject);
procedure DBGrid1Exit(Sender: TObject);
private

{ Private declarations }
public

{ Public declarations }
end;


var
Form1: TForm1;
Imger_Drive:string;
table_edit:boolean;
implementation

{$R *.dfm}
Function GetDriveName:string;//获得第一个空闲的驱动器符
var
D1 : set of 0..25;
D2 : integer;
begin
DWORD( D1 ) := Windows.GetLogicalDrives;
for D2 := 3 to 25 do Begin
if Not (D2 in D1) then Begin
Result := chr( D2 + Ord( 'A') );
Break;
End;
End;
end;

function wnetadd(var driver_name:string;ip:string):string;
//网络映射函数
var NetR :NETRESOURCE;ErrInfo : Longint;
begin
NetR.dwScope := RESOURCE_GLOBALNET;
NetR.dwType := RESOURCETYPE_DISK;
NetR.dwDisplayType := RESOURCEDISPLAYTYPE_SHARE;
NetR.dwUsage := RESOURCEUSAGE_CONNECTABLE;
NetR.lpLocalName := pchar(driver_name);
NetR.lpRemoteName :=pchar(ip);
NetR.lpProvider := '';
ErrInfo := WNetAddConnection2(NetR,pchar(''),pchar('administrator'),CONNECT_UPDATE_PROFILE);
If ErrInfo = NO_ERROR Then
Result:='1'
Else
Result:='没有映射盘!';
end;

//断开映射网络驱动器
procedure wnetdel(var driver_name:string);
var ErrInfo : Longint;
strLocalName : pchar;
begin
strLocalName:=pchar(driver_name);
ErrInfo := WNetCancelConnection2(strLocalName, CONNECT_UPDATE_PROFILE,False);
If not ErrInfo = NO_ERROR Then
messagebox(0, 'ERROR' ,'' ,0);
end;

function filecopy(var sFromFileName, sToFileName: AnsiString):string;
//文件拷贝函数
begin
if CopyFile(pchar(sFromFileName), pchar(sToFileName), false) then
Result:='ok'
else
result:=IntToStr(GetLastError);
//2—原文件不存在 3—目标文件无法建立
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
close;
end;

procedure TForm1.FormActivate(Sender: TObject);
const
cMoonCn: array[1..12] of string =
( '一月', '二月', '三月','四月','五月','六月','七月','八月','九月','十月','十一月','十二月');
var i:integer;
month,year,day:word;
begin
Imger_Drive:=(GetDriveName)+':';//获得最后一个未使用的盘符
for i:=1 to 12 do
ComboBox1.Items.Add(cMoonCn);
DecodeDate(Date, Year, Month, Day);
combobox1.ItemIndex:=Month-1;
edit1.Text:=inttostr(year);
wnetdel(Imger_Drive);
i:=0;
while not table1.Eof do
begin
i:=i+1;
table1.Next;
end;
ProgressBar1.Max:=i;
ProgressBar1.Min:=0;
table1.First;
table_edit:=false;
end;

procedure TForm1.Button1Click(Sender: TObject);
var month :integer;
months,Ip_address,Yd_address,Md_address,temp:string;
begin
listbox1.Clear ;
month:=combobox1.ItemIndex+1 ;//所选备份月份
//listbox1.Items.Add(inttostr(month)); 测试用
if month<10 then
months:='0'+inttostr(month)
else
months:=inttostr(month);
repeat
Ip_address:='//'+table1IP.Value+'/d$' ; //得到IP地址
Yd_address:=Imger_drive+table1IP_PATH.Value +edit1.Text+months+'.txt';
Md_address:=table1F_PATH.Value +edit1.Text+months+'.txt';
StatusBar1.Panels[0].Text:='信息:正在映射'+Ip_address;
statusbar1.Refresh;
temp:=wnetadd(Imger_Drive,Ip_address);
//listbox1.Items .Add (md_address);
if temp='1' then
begin
StatusBar1.Panels[0].Text :='信息:映射'+Ip_address+'成功';
statusbar1.Refresh;
temp:=filecopy(Yd_address,Md_address);
StatusBar1.Panels[0].Text:='信息:正在拷贝'+table1mc.Value+'文件' ;
statusbar1.Refresh;
if temp='ok' then
begin
StatusBar1.Panels[0].Text:='信息:拷贝'+table1mc.Value +'成功';
statusbar1.Refresh;
listbox1.Items .Add (table1mc.value+'拷贝成功');
wnetdel(Imger_Drive);
end
else
begin

if temp='2' then
begin
StatusBar1.Panels[0].Text:='信息:'+table1mc.value+'文件不存在';
statusbar1.Refresh;
listbox1.Items .Add (table1mc.value+'文件不存在');
wnetdel(Imger_Drive);
end
else
begin
StatusBar1.Panels[0].Text:='信息:'+table1mc.value+'拷贝错误';
statusbar1.Refresh;
listbox1.Items .Add (table1mc.value+'拷贝错误');
wnetdel(Imger_Drive);
end;
end;
end
else
begin
StatusBar1.Panels[0].Text:='信息:'+table1mc.value+'映射驱动器错误';
statusbar1.Refresh;
listbox1.Items.Add(table1mc.value+'映射驱动器错误');
end;
ProgressBar1.StepIt;
table1.Next;
listbox1.Refresh ;
until table1.Eof; //数据库是否结束
table1.First;
end;
procedure TForm1.DBGrid1DblClick(Sender: TObject);
//双击DBGrid时,将其设为可修改
begin
if not table_edit then
begin
DBGrid1.ReadOnly :=false;
table_edit:=true;
StatusBar1.Panels[0].Text:='信息:'+'可修改数据库!';
statusbar1.Refresh;
end;
end;

procedure TForm1.DBGrid1Exit(Sender: TObject);
//当焦点离开DBGrid时,将其设为只读
begin
if table_edit then
begin
DBGrid1.ReadOnly:=true;
table_edit:=false;
StatusBar1.Panels[0].Text:='信息:'+'修改数据库完毕!';
statusbar1.Refresh;
end;
end;
end.
警告提示为:
[Warning] TEST.pas(72): Unsafe type 'lpLocalName: PAnsiChar'
[Warning] TEST.pas(72): Unsafe type 'PChar'
[Warning] TEST.pas(73): Unsafe type 'lpRemoteName: PAnsiChar'
[Warning] TEST.pas(73): Unsafe type 'PChar'
[Warning] TEST.pas(74): Unsafe type 'lpProvider: PAnsiChar'
[Warning] TEST.pas(75): Unsafe type 'PChar'
[Warning] TEST.pas(75): Unsafe type 'PChar'
[Warning] TEST.pas(85): Unsafe type 'PChar'
[Warning] TEST.pas(87): Unsafe type 'strLocalName: PAnsiChar'
[Warning] TEST.pas(87): Unsafe type 'PChar'
[Warning] TEST.pas(88): Unsafe type 'strLocalName: PAnsiChar'
[Warning] TEST.pas(96): Unsafe type 'PChar'
[Warning] TEST.pas(96): Unsafe type 'PChar'

 
是delphi对新的类型检查吧,不用管。
 
警告那是為了以後升級到.net時,事先主一聲的。
程序執行有問題那就要看是copy時出的,還是調用網絡映射時,或是別的地方,調試下就清楚了。
 
没有什么问题,那些Warning尽可不去理它们!
 
后退
顶部