小弟初学delphi 一个自动上传文件同时改订单状态的程序 下面的代码是用timer调用的
当程序运行时间长了以后就会报错
那个“xxxxxx”会变的,每次不一样 in module 有时候有 有时候没procedure TForm1.downListAndUpload();
var
i: Integer;
j: Integer;
begin
ListView1.Clear();
Panel2.Visible := false; //下载FTP上的文件列表
if not FileExists(ExtractFilePath(Paramstr(0)) + userName + '.txt') then
begin
FtpLibrary1.localpath := ExtractFilePath(Paramstr(0)) + userName + '.txt';
FtpLibrary1.remotepath := userName + '.txt';
if FtpLibrary1.ExistFile(userName + '.txt') then
begin
if FtpLibrary1.Download() then
FtpLibrary1.DeleteFile(userName + '.txt');
end
else
begin
if CheckBox3.Checked = true then
//自动关机
ShutDown();
end;
end;
//列表存在 解析文件列表 加入listview
if FileExists(ExtractFilePath(Paramstr(0)) + userName + '.txt') then
begin
mystring := TStringlist.Create;
mystring.LoadFromFile(ExtractFilePath(Paramstr(0)) + userName + '.txt');
list := TStringlist.Create;
ExtractStrings(['|'], [], Pchar(mystring.text), list);
mystring.Free;
//增加
for i := 0 to list.Count - 1 do
begin
sub := TStringlist.Create;
ExtractStrings(['$'], [], Pchar(list[i]), sub);
ListItem := ListView1.Items.Add;
ListItem.Caption := StringReplace(sub[0], ' ', '', [rfReplaceAll]); //添加标题
ListItem.SubItems.Add(inttostr(i));
sub.Free;
end; FtpLibrary1.Encoding := 'UTF8';
FtpLibrary1.ReplaceSetting := 2;
isUpdating := true; //上传到服务器 for i := 0 to list.Count - 1 do
begin
sub := TStringlist.Create;
ExtractStrings(['$'], [], Pchar(list[i]), sub);
FtpLibrary1.localpath := sub[0];
tempWide := sub[0];
tempWide := ExtractFileName(tempWide); FtpLibrary1.remotepath := string(tempWide); if FtpLibrary1.Upload() then
begin
url := baseUrl+'/clientlogin!updateOrdersByFileName?orderCode='
+ sub[1];
Idhttp1.HandleRedirects := true; //必须支持重定向否则可能出错
Idhttp1.ReadTimeout := 5000; //超过这个时间则不再访问
try
s := Idhttp1.Get(url);
except
url := baseUrl1+'/clientlogin!updateOrdersByFileName?orderCode='
+ sub[1];
try
s := Idhttp1.Get(url);
except
s := 'fail';
end;
end; for j := 0 to listview1.Items.Count - 1 do
begin
if SameText(ListView1.Items[j].Caption,sub[0]) then
begin
ListView1.Items.Delete(j);
Break;
end;
end
end
else
begin
for j := 0 to listview1.Items.Count - 1 do
begin
if SameText(ListView1.Items[j].Caption,sub[0]) then
ListView1.Items.Delete(j);
Break;
end;
end;
end;
list.Free;
sub.Free;
isUpdating := false;
Panel2.Visible := true;
//上传完删除文件列表
sleep(1000);
DeleteFile(ExtractFilePath(Paramstr(0)) + userName + '.txt');
end;
Timer1.Enabled := true;
end;
当程序运行时间长了以后就会报错
那个“xxxxxx”会变的,每次不一样 in module 有时候有 有时候没procedure TForm1.downListAndUpload();
var
i: Integer;
j: Integer;
begin
ListView1.Clear();
Panel2.Visible := false; //下载FTP上的文件列表
if not FileExists(ExtractFilePath(Paramstr(0)) + userName + '.txt') then
begin
FtpLibrary1.localpath := ExtractFilePath(Paramstr(0)) + userName + '.txt';
FtpLibrary1.remotepath := userName + '.txt';
if FtpLibrary1.ExistFile(userName + '.txt') then
begin
if FtpLibrary1.Download() then
FtpLibrary1.DeleteFile(userName + '.txt');
end
else
begin
if CheckBox3.Checked = true then
//自动关机
ShutDown();
end;
end;
//列表存在 解析文件列表 加入listview
if FileExists(ExtractFilePath(Paramstr(0)) + userName + '.txt') then
begin
mystring := TStringlist.Create;
mystring.LoadFromFile(ExtractFilePath(Paramstr(0)) + userName + '.txt');
list := TStringlist.Create;
ExtractStrings(['|'], [], Pchar(mystring.text), list);
mystring.Free;
//增加
for i := 0 to list.Count - 1 do
begin
sub := TStringlist.Create;
ExtractStrings(['$'], [], Pchar(list[i]), sub);
ListItem := ListView1.Items.Add;
ListItem.Caption := StringReplace(sub[0], ' ', '', [rfReplaceAll]); //添加标题
ListItem.SubItems.Add(inttostr(i));
sub.Free;
end; FtpLibrary1.Encoding := 'UTF8';
FtpLibrary1.ReplaceSetting := 2;
isUpdating := true; //上传到服务器 for i := 0 to list.Count - 1 do
begin
sub := TStringlist.Create;
ExtractStrings(['$'], [], Pchar(list[i]), sub);
FtpLibrary1.localpath := sub[0];
tempWide := sub[0];
tempWide := ExtractFileName(tempWide); FtpLibrary1.remotepath := string(tempWide); if FtpLibrary1.Upload() then
begin
url := baseUrl+'/clientlogin!updateOrdersByFileName?orderCode='
+ sub[1];
Idhttp1.HandleRedirects := true; //必须支持重定向否则可能出错
Idhttp1.ReadTimeout := 5000; //超过这个时间则不再访问
try
s := Idhttp1.Get(url);
except
url := baseUrl1+'/clientlogin!updateOrdersByFileName?orderCode='
+ sub[1];
try
s := Idhttp1.Get(url);
except
s := 'fail';
end;
end; for j := 0 to listview1.Items.Count - 1 do
begin
if SameText(ListView1.Items[j].Caption,sub[0]) then
begin
ListView1.Items.Delete(j);
Break;
end;
end
end
else
begin
for j := 0 to listview1.Items.Count - 1 do
begin
if SameText(ListView1.Items[j].Caption,sub[0]) then
ListView1.Items.Delete(j);
Break;
end;
end;
end;
list.Free;
sub.Free;
isUpdating := false;
Panel2.Visible := true;
//上传完删除文件列表
sleep(1000);
DeleteFile(ExtractFilePath(Paramstr(0)) + userName + '.txt');
end;
Timer1.Enabled := true;
end;
解决方案 »
- 为什么用程序 备份 MYSQL 不行
- 我写的最菜鸟的一个动态链接函数,不懂怎么调用(动态或静态),哪位帮帮忙?
- 如何控制下拉列表中的值不可更改
- 如何从sql中的表单中读取数据来进行逐个比较?
- 超难问题高分求解,如何在两个查询结果,得出这样的结果。救急啊。。。。。
- 关于CHART问题---急!!!!在线等。
- 很简单的问题,分不够了再加:Delphi如何实现向指定的IP或者计算机名地址发送消息,象Net Send 命令一样
- 为什么没有肌肉增强激素
- 关于SQL Server2000personal连接问题,很简单,高手请进!!很急很急!不解决可能会失业!!:(帮帮小弟!
- 请教用过FAST REPORT的前辈,怎样设置打印出来的纸张大小
- Delphi中ActionManager用法(麻烦举个实例)
- DBGrid问题
一般有删除的情况下,循环都是从高到低的,否则,就会出现数据溢出的,比如:本来是10条,你删除1条,剩9条,你的循环还去找第10条,肯定会出错的。 for j := 0 to listview1.Items.Count - 1 do//应改为for j := listview1.Items.Count - 1 to 0
begin
if SameText(ListView1.Items[j].Caption,sub[0]) then
ListView1.Items.Delete(j);
Break;
end;
Timer1执行了应该设置Enabled := flase;
downListAndUpload执行结束后再设置Enabled := true;
begin
sub := TStringlist.Create;
ExtractStrings(['$'], [], Pchar(list[i]), sub);
ListItem := ListView1.Items.Add;
ListItem.Caption := StringReplace(sub[0], ' ', '', [rfReplaceAll]); //添加标题
ListItem.SubItems.Add(inttostr(i));
sub.Free;
end;
这里频繁的创建TStringlist然后释放,如果不是多线程程序,建议弄个全局的每次清空即可2 倒序删除listview1中的项目,你这样写会有问题的
for j := 0 to listview1.Items.Count - 1 do
begin
if SameText(ListView1.Items[j].Caption,sub[0]) then
begin
ListView1.Items.Delete(j);
Break;
end;
end3 for i := 0 to list.Count - 1 do
begin
sub := TStringlist.Create;
这句sub := TStringlist.Create;是在for里创建,for循环外释放的,会内存泄漏
还有看看Break是否放错地方了;