线急问！buffer问题，在线等！(100分)

  • 主题发起人 主题发起人 flying_i_am
  • 开始时间 开始时间
F

flying_i_am

Unregistered / Unconfirmed
GUEST, unregistred user!
THardWare_Info=record //硬件信息
HW_Name:string[255];//硬件名称
HW_Content:array [0..1000] of char;//硬件描述
end;


HardWare_InfoArray: array of THardWare_Info;



function TMainFrm.SetHardWareInfoBuffer(AThread: TIdPeerThread): boolean;
var
HardWare_InfoArray: array of THardWare_Info;
CountNumber, i: integer;
begin
with AThread.Connection do
begin
GetHardWare_InfoCount(CountNumber);
OpenWriteBuffer;
try
Writeinteger(CountNumber);
if CountNumber>0 then
begin
setlength(HardWare_InfoArray, CountNumber);
GetHardWare_Info(HardWare_InfoArray); //从注册表中读的信息加入列表，在转移到结构体中
for i := 0 to CountNumber - 1 do
begin
WriteBuffer(HardWare_InfoArray, Sizeof(HardWare_InfoArray), False);
end;
end;
// CancelWriteBuffer;
CloseWriteBuffer;
except
CancelWriteBuffer;
raise;
end;
在段程序中到CloseWriteBuffer;时报错！如下图

http://photos.gznet.com/photos/1119203/1119203-GHCwmtdfna.JPG

请指教！


 
图不重要，关键是你的代码不全，看不出什么地方破坏了内存。
 
procedure TMainFrm.GetClassDevice(var TName, TTypeInfo: TStringList);
//取得硬盘和光驱型号
var
i, j: integer;
sTempl, sTemp2, sTemp3: TStringList;
SML1, SML2,STemp: string;
Registry: TRegistry;
const
rv = 'DriverDesc';
rk = 'HARDWARE/DEVICEMAP/Scsi';
begin
Registry := TRegistry.Create;
sTempl := TStringList.Create;
try
with Registry do
begin
rootkey := HKEY_LOCAL_MACHINE;
if openkey(rk, False) then
begin
getkeynames(sTempl);
closekey;
sTemp2 := TStringList.Create;
sTemp3 := TStringList.Create;
for i := 0 to sTempl.Count - 1 do
if openkey(rk + '/' + sTempl + '/Scsi Bus 0', False) then
begin
SML1 := sTempl;
getkeynames(sTemp2);
closekey;
for j := 0 to sTemp2.Count - 1 do
begin
SML2 := rk + '/' + SML1 + '/Scsi Bus 0/' + sTemp2[j];
if openkey(SML2, False) then
begin
getkeynames(sTemp3);
closekey;
if sTemp3.Count <> 0 then
begin
openkey(SML2 + '/Logical Unit Id 0', False);
if valueexists('Identifier') then
begin
STemp := ReadString('Identifier');
TName.Add(STemp);
end;
if valueexists('Type') then
begin
STemp := ReadString('Type');
if STemp = 'DiskPeripheral' then
TTypeInfo.Add('硬盘驱动器')
else if STemp = 'CdRomPeripheral' then
TTypeInfo.Add('光盘驱动器')
else
TTypeInfo.Add('未知驱动器')
end;
closekey;
end;
end; // break;
end;
end;
end;
end;
finally
if Assigned(Registry) then
Registry.Free;
if Assigned(sTempl) then
sTempl.Free;
if Assigned(sTemp2) then
sTemp2.Free;
if Assigned(sTemp3) then
sTemp3.Free;
end;
end;

procedure TMainFrm.GetHardWare_Info(var HardWare_InfoArray: array of THardWare_Info);
var
SLTempType, SLTempDecs, SNetWorkCard: TStringList;
i, j, k: integer;
STemp, STemp1: string;
begin
j := 0;
STemp := GetCPUAllInfo;
if STemp <> '' then
begin
j := j + 1;
HardWare_InfoArray[j].HW_Name := 'CPU';
for i := 0 to length(STemp) - 1 do
begin
HardWare_InfoArray[j].HW_Content := STemp[i + 1];
end;
end;
STemp := GetBIosInfo;
if STemp <> '' then
begin
j := j + 1;
HardWare_InfoArray[j].HW_Name := 'BIOS';
for i := 0 to length(STemp) - 1 do
begin
HardWare_InfoArray[j].HW_Content := STemp[i + 1];
end;
end;

GetAllMemoryInfo(STemp, STemp1);
if (STemp <> '') then
begin
j := j + 1;
HardWare_InfoArray[j].HW_Name := '物理内存';
for i := 0 to length(STemp) - 1 do
begin
HardWare_InfoArray[j].HW_Content := STemp[i + 1];
end;
end;
if (STemp1 <> '') then
begin
j := j + 1;
HardWare_InfoArray[j].HW_Name := '虚拟内存';
for i := 0 to length(STemp1) - 1 do
begin
HardWare_InfoArray[j].HW_Content := STemp1[i + 1];
end;
end;



STemp := trim(GetDisplayCardInfo);
if STemp <> '' then
begin
j := j + 1;
HardWare_InfoArray[j].HW_Name := '显卡';
for i := 0 to length(STemp) - 1 do
begin
HardWare_InfoArray[j].HW_Content := STemp[i + 1];
end;
end;

STemp := trim(GetSoundCardInfo);
if STemp <> '' then
begin
j := j + 1;
HardWare_InfoArray[j].HW_Name := '声卡';
for i := 0 to length(STemp) - 1 do
begin
HardWare_InfoArray[j].HW_Content := STemp[i + 1];
end;
end;
SNetWorkCard := TStringList.Create;
try
if GetWin32NetWorkCardInfo(SNetWorkCard) then
begin
if SNetWorkCard.Count <> 0 then
begin
for k := 0 to SNetWorkCard.Count - 1 do
begin
j := j + 1;
HardWare_InfoArray[j].HW_Name := '网卡';
STemp := SNetWorkCard[k];
for i := 0 to length(STemp) - 1 do
begin
HardWare_InfoArray[j].HW_Content := STemp[i + 1];
end;
end;
end;
end;
finally
if Assigned(SNetWorkCard) then SNetWorkCard.Free;
end;

STemp := trim(GetPrinterInfo);
if STemp <> '' then
begin
j := j + 1;
HardWare_InfoArray[j].HW_Name := '打印机';
for i := 0 to length(STemp) - 1 do
begin
HardWare_InfoArray[j].HW_Content := STemp[i + 1];
end;
end;


STemp := trim(GetFloppykInfo);
if STemp <> '' then
begin
j := j + 1;
HardWare_InfoArray[j].HW_Name := '软驱';
for i := 0 to length(STemp) - 1 do
begin
HardWare_InfoArray[j].HW_Content := STemp[i + 1];
end;
end;
SLTempType:= TStringList.Create;
SLTempDecs := TStringList.Create;
try
GetClassDevice(SLTempDecs, SLTempType);
for k := 0 to SLTempDecs.Count - 1 do
begin
j := j + 1;
HardWare_InfoArray[j].HW_Name := SLTempType[k];
STemp := SLTempDecs[k];
for i := 0 to length(STemp) - 1 do
begin
HardWare_InfoArray[j].HW_Content := STemp[i + 1];
end;
end;
finally
if Assigned(SLTempDecs) then SLTempDecs.Free;
if Assigned(SLTempType) then SLTempType.Free;
end;

end;

if Assigned(SLTempDecs) then SLTempDecs.Free; 到这个地方出问题！
我估计这个函数出了问题！请大家帮我看看！
 
估计procedure TMainFrm.GetClassDevice(var TName, TTypeInfo: TStringList);这个函数出了问题！请大家帮我看看！
 
procedure TMainFrm.GetHardWare_Info(var HardWare_InfoArray: array of THardWare_Info);
var
SLTempType, SLTempDecs, SNetWorkCard: TStringList;
i, j, k: integer;
STemp, STemp1: string;
begin
j := 0;
STemp := GetCPUAllInfo;
if STemp <> '' then
begin
j := j + 1;
HardWare_InfoArray[j].HW_Name := 'CPU';
for i := 0 to length(STemp) - 1 do
begin
HardWare_InfoArray[j].HW_Content := STemp[i + 1];
end;
end;
STemp := GetBIosInfo;
if STemp <> '' then
begin
j := j + 1;
HardWare_InfoArray[j].HW_Name := 'BIOS';
for i := 0 to length(STemp) - 1 do
begin
HardWare_InfoArray[j].HW_Content := STemp[i + 1];
end;
end;

GetAllMemoryInfo(STemp, STemp1);
if (STemp <> '') then
begin
j := j + 1;
HardWare_InfoArray[j].HW_Name := '物理内存';
for i := 0 to length(STemp) - 1 do
begin
HardWare_InfoArray[j].HW_Content := STemp[i + 1];
end;
end;
if (STemp1 <> '') then
begin
j := j + 1;
HardWare_InfoArray[j].HW_Name := '虚拟内存';
for i := 0 to length(STemp1) - 1 do
begin
HardWare_InfoArray[j].HW_Content := STemp1[i + 1];
end;
end;



STemp := trim(GetDisplayCardInfo);
if STemp <> '' then
begin
j := j + 1;
HardWare_InfoArray[j].HW_Name := '显卡';
for i := 0 to length(STemp) - 1 do
begin
HardWare_InfoArray[j].HW_Content := STemp[i + 1];
end;
end;

STemp := trim(GetSoundCardInfo);
if STemp <> '' then
begin
j := j + 1;
HardWare_InfoArray[j].HW_Name := '声卡';
for i := 0 to length(STemp) - 1 do
begin
HardWare_InfoArray[j].HW_Content := STemp[i + 1];
end;
end;
SNetWorkCard := TStringList.Create;
try
if GetWin32NetWorkCardInfo(SNetWorkCard) then
begin
if SNetWorkCard.Count <> 0 then
begin
for k := 0 to SNetWorkCard.Count - 1 do
begin
j := j + 1;
HardWare_InfoArray[j].HW_Name := '网卡';
STemp := SNetWorkCard[k];
for i := 0 to length(STemp) - 1 do
begin
HardWare_InfoArray[j].HW_Content := STemp[i + 1];
end;
end;
end;
end;
finally
if Assigned(SNetWorkCard) then SNetWorkCard.Free;
end;

STemp := trim(GetPrinterInfo);
if STemp <> '' then
begin
j := j + 1;
HardWare_InfoArray[j].HW_Name := '打印机';
for i := 0 to length(STemp) - 1 do
begin
HardWare_InfoArray[j].HW_Content := STemp[i + 1];
end;
end;
SLTempType:= TStringList.Create;//[red]把这个提到前面就不出错，但在closebuffer时出错[/red]
SLTempDecs := TStringList.Create;
try
GetClassDevice(SLTempDecs, SLTempType);
for k := 0 to SLTempDecs.Count - 1 do
begin
j := j + 1;
HardWare_InfoArray[j].HW_Name := SLTempType[k];
STemp := SLTempDecs[k];
for i := 0 to length(STemp) - 1 do
begin
HardWare_InfoArray[j].HW_Content := STemp[i + 1];
end;
end;
finally
if Assigned(SLTempDecs) then SLTempDecs.Free;
if Assigned(SLTempType) then SLTempType.Free;
end;

STemp := trim(GetFloppykInfo);
if STemp <> '' then
begin
j := j + 1;
HardWare_InfoArray[j].HW_Name := '软驱';
for i := 0 to length(STemp) - 1 do
begin
HardWare_InfoArray[j].HW_Content := STemp[i + 1];
end;
end;


end;
 
[:(][:(][:(]
没人回答！急！
 
结束！辛苦费！
 
您必须登录或注册才可回复。

Similar threads

S
[转]ClientDataSet加上TDataSetProvider的数据保存问题
回复
0
查看
3K
SUNSTONE的Delphi笔记
S
S
[转]ClientDataSet加上TDataSetProvider的数据保存问题
回复
0
查看
2K
SUNSTONE的Delphi笔记
S
I
stringgrid从文本读入的问题
回复
0
查看
685
import
I
I
关于数组的一个问题
回复
0
查看
548
import
I
I
获取打印机的打印任务列表
回复
0
查看
2K
import
I
后退
顶部