Delphi内存释放问题(100分)

我有一个24小时常开的服务器程序，但开得太长时间后系统会出现内存地址错误？且系统CPU会不断升高。请问有什么办法可以让服务器程序动态的分配内存空间，使内存消耗稳定而不至于“死机”？？急！！！

检查你的服务器程序，有没有内存泄漏

是不是不断的创建对象用完了没有释放？

1、内存泄露。
2、不停的创建对象?

出现内存地址错误，可能是因为使用了被释放的对象造成的，也可能是释放了对象而没有置空。
系统CPU会不断升高，这和你程序中的涉及到的连续执行的代码有关，比如一些循环，你检查一下是不是有死循环。
动态的分配内存空间，坚持一个原则：在那里create,在那里destroy。对每一个对象的创建都要清楚在那里做了释放，如在循环体中有创建更要注意是如何释放的。

各位大虾都说得不错，待小弟试后散分。若有未解决问题继续请教。另外：在开发中，我遇到与此无关的问题，顺便请教一下：Excel导出时，怎样设置导出各列都为文本（避免15位以上数字变成科学计数法）？谢谢出招：）

你在google里查一下，有很多例子
unit XlsFileUnit;

interface

uses
Windows,Messages,SysUtils,Classes,Graphics,Controls,Grids,Forms,
Dialogs,db,dbctrls,DBGrids,ComObj,Variants,Excel2000, OleServer;
const
{BOF}
CBOF =$0009;
BIT_BIFF5 = $0800;
BOF_BIFF5 = CBOF or BIT_BIFF5;
{EOF}
BIFF_EOF = $000a;
{Document types}
DOCTYPE_XLS = $0010;
{Dimensions}
DIMENSIONS = $0000;

c_maxCols=100;
c_maxRows=65534;
type
TAtributCell = (acHidden,acLocked,acShaded,acBottomBorder,acTopBorder,
acRightBorder,acLeftBorder,acLeft,acCenter,acRight,acFill);

TSetOfAtribut = set of TatributCell;

TXLSWriter = class(Tobject)
private
FStream:TFileStream;
procedure WriteWord(w:word);
protected
procedure WriteBOF;
procedure WriteEOF;
procedure WriteDimension;
public
maxCols,maxRows:Word;
procedure CellWord(vCol,vRow:word;aValue:word;vAtribut:TSetOfAtribut=[]);
procedure CellDouble(vCol,vRow:word;aValue:double;vAtribut:TSetOfAtribut=[]);
procedure CellStr(vCol,vRow:word;aValue:String;vAtribut:TSetOfAtribut=[]);
procedure WriteField(vCol,vRow:word;Field:TField);
constructor create(vFileName:string);
destructor destroy;override;
end;

procedure SetCellAtribut(value:TSetOfAtribut;var FAtribut:array of byte);
procedure DataSetToXLS(ds:TDataSet;fname:String;XLSList:TStrings=nil);
procedure DBgridToXLS(dbgrid:TDBGrid;fname:String;collist:TStrings=nil;XLSList:TStrings=nil); // collist.addobject('FieldName',tobject(Caption))
procedure StringGridToXLS(grid:TStringGrid;fname:String;XLSList:TStrings=nil);
procedure UniteXLSFiles(XLSFileNames:TStrings;DelOtherExl:Boolean = false); //合并多个excel文件
implementation

procedure DataSetToXLS(ds:TDataSet;fname:String;XLSList:TStrings);
var
c,r,x,i:Integer;
xls:TXLSWriter;
NewName,dir:string;
begin
if XLSList<>nil then
XLSList.Clear;
ds.first;
x:=ds.RecordCount div c_maxRows;
if ds.RecordCount mod c_maxRows >0 then inc(x);
for i:= 1 to x do
begin
if i>1 then
begin
dir := ExtractFileDir(fname);
NewName := ExtractFileName(fname);
NewName := copy(NewName,1,pos('.',NewName)-1)+inttostr(i)+'.xls';
end
else
NewName:=fname;
xls:=TXLSWriter.create(NewName);
if ds.FieldCount > xls.maxcols then
xls.maxcols:=ds.fieldcount+1;
try
xls.writeBOF;
xls.WriteDimension;
for c:=0 to ds.FieldCount-1 do
xls.Cellstr(0,c,ds.Fields[c].DisplayLabel);
r:=1;
while (not ds.eof) and (r <= xls.maxrows) do
begin
for c:=0 to ds.FieldCount-1 do
if ds.Fields[c].AsString<>'' then
xls.WriteField(r,c,ds.Fields[c]);
inc(r);
ds.next;
end;
xls.writeEOF;
if XLSList<>nil then
XLSList.Add(NewName) ;
finally
xls.free;
end;
end; //for
end;

procedure DBgridToXLS(dbgrid:TDBGrid;fname:String;collist:TStrings;XLSList:TStrings); // collist.addobject('FieldName',tobject(Caption))
var
c,r,x,i:Integer;
xls:TXLSWriter;
NewName,dir:string;
stringlist:TStringList;
titlelist:TStringList;
begin
if XLSList<>nil then
XLSList.Clear;
dbgrid.DataSource.DataSet.DisableControls;
dbgrid.DataSource.DataSet.First;
x:=dbgrid.DataSource.DataSet.RecordCount div c_maxRows;
if dbgrid.DataSource.DataSet.RecordCount mod c_maxRows >0 then inc(x);
for i:= 1 to x do
begin
if i>1 then
begin
dir := ExtractFileDir(fname);
NewName := ExtractFileName(fname);
NewName := copy(NewName,1,pos('.',NewName)-1)+inttostr(i)+'.xls';
end
else
NewName:=fname;
xls:=TXLSWriter.create(NewName);
stringlist := TStringList.Create;
titlelist := TStringList.Create;
if collist=nil then
begin
for c:=0 to dbgrid.Columns.Count-1 do
begin
if dbgrid.Columns[c].Visible = true then
begin
stringlist.Append(dbgrid.Columns[c].FieldName);
titlelist.Append(dbgrid.Columns[c].Title.Caption);
end;
end;
end
else
begin
for c:=0 to collist.Count-1 do
begin
stringlist.Append(collist.Strings[c]);
titlelist.Append(string(collist.Objects[c]));
end;
end;

if stringlist.Count > xls.maxcols then
xls.maxcols:=stringlist.Count+1;
try
xls.writeBOF;
xls.WriteDimension;
for c:=0 to stringlist.Count -1 do
xls.Cellstr(0,c,titlelist[c]);
r:=1;

while (not dbgrid.DataSource.DataSet.eof) and (r <= xls.maxrows) do
begin
for c:=0 to stringlist.Count -1 do
if dbgrid.DataSource.DataSet.FieldByName(stringlist[c]).AsString<>'' then
xls.WriteField(r,c,dbgrid.DataSource.DataSet.FieldByName(stringlist[c]));
inc(r);
dbgrid.DataSource.DataSet.next;
end;
xls.writeEOF;
if XLSList<>nil then
XLSList.Add(NewName);
finally
FreeAndNil(titlelist);
FreeAndNil(stringlist);
xls.free;
dbgrid.DataSource.DataSet.EnableControls;
end;
end; //for
end;

procedure StringGridToXLS(grid:TStringGrid;fname:String;XLSList:TStrings);
var
c,r,rMax:Integer;
xls:TXLSWriter;
begin
xls:=TXLSWriter.create(fname);
rMax:=grid.RowCount;
if grid.ColCount > xls.maxcols then
xls.maxcols:=grid.ColCount+1;
if rMax > xls.maxrows then // &brvbar;&sup1;&reg;&aelig;&brvbar;&iexcl;&sup3;&Igrave;&brvbar;h&yen;u&macr;à&brvbar;s 65535 Rows
rMax:=xls.maxrows;
try
xls.writeBOF;
xls.WriteDimension;
for c:=0 to grid.ColCount-1 do
for r:=0 to rMax-1 do
xls.Cellstr(r,c,grid.Cells[c,r]);
xls.writeEOF;
finally
xls.free;
end;
end;

{ TXLSWriter }

constructor TXLSWriter.create(vFileName:string);
begin
inherited create;
if FileExists(vFilename) then
fStream:=TFileStream.Create(vFilename,fmOpenWrite)
else
fStream:=TFileStream.Create(vFilename,fmCreate);

maxCols:=c_maxCols; // <2002-11-17> dllee Column &Agrave;&sup3;&cedil;&Oacute;&not;O¤&pound;&yen;i&macr;à¤j&copy;ó 65535, &copy;&Ograve;&yen;H¤&pound;&brvbar;A&sup3;B&sup2;z
maxRows:=c_maxRows; // <2002-11-17> dllee &sup3;o&shy;&Oacute;&reg;&aelig;&brvbar;&iexcl;&sup3;&Igrave;¤j&yen;u&macr;à&sup3;o&raquo;ò¤j&iexcl;A&frac12;&ETH;&ordf;`·N¤j&ordf;&ordm;&cedil;ê&reg;&AElig;&reg;w&laquo;&Uuml;&reg;e&copy;&ouml;&acute;N¤j&copy;ó&sup3;o&shy;&Oacute;&shy;&Egrave;
end;

destructor TXLSWriter.destroy;
begin
if fStream <> nil then
fStream.free;
inherited;
end;

procedure TXLSWriter.WriteBOF;
begin
Writeword(BOF_BIFF5);
Writeword(6); // count of bytes
Writeword(0);
Writeword(DOCTYPE_XLS);
Writeword(0);
end;

procedure TXLSWriter.WriteDimension;
begin
Writeword(DIMENSIONS); // dimension OP Code
Writeword(8); // count of bytes
Writeword(0); // min cols
Writeword(maxRows); // max rows
Writeword(0); // min rowss
Writeword(maxcols); // max cols
end;

procedure TXLSWriter.CellDouble(vCol, vRow: word; aValue: double;
vAtribut: TSetOfAtribut);
var FAtribut:array [0..2] of byte;
begin
Writeword(3); // opcode for double
Writeword(15); // count of byte
Writeword(vCol);
Writeword(vRow);
SetCellAtribut(vAtribut,fAtribut);
fStream.Write(fAtribut,3);
fStream.Write(aValue,8);
end;

procedure TXLSWriter.CellWord(vCol,vRow:word;aValue:word;vAtribut:TSetOfAtribut=[]);
var FAtribut:array [0..2] of byte;
begin
Writeword(2); // opcode for word
Writeword(9); // count of byte
Writeword(vCol);
Writeword(vRow);
SetCellAtribut(vAtribut,fAtribut);
fStream.Write(fAtribut,3);
Writeword(aValue);
end;

procedure TXLSWriter.CellStr(vCol, vRow: word; aValue: String;
vAtribut: TSetOfAtribut);
var
FAtribut:array [0..2] of byte;
slen:byte;
begin
Writeword(4); // opcode for string
slen:=length(avalue);
Writeword(slen+8); // count of byte
Writeword(vCol);
Writeword(vRow);
SetCellAtribut(vAtribut,fAtribut);
fStream.Write(fAtribut,3);
fStream.Write(slen,1);
fStream.Write(aValue[1],slen);
end;

procedure SetCellAtribut(value:TSetOfAtribut;var FAtribut:array of byte);
var
i:integer;
begin
//reset
for i:=0 to High(FAtribut) do
FAtribut:=0;

if acHidden in value then //byte 0 bit 7:
FAtribut[0] := FAtribut[0] + 128;

if acLocked in value then //byte 0 bit 6:
FAtribut[0] := FAtribut[0] + 64 ;

if acShaded in value then //byte 2 bit 7:
FAtribut[2] := FAtribut[2] + 128;

if acBottomBorder in value then //byte 2 bit 6
FAtribut[2] := FAtribut[2] + 64 ;

if acTopBorder in value then //byte 2 bit 5
FAtribut[2] := FAtribut[2] + 32;

if acRightBorder in value then //byte 2 bit 4
FAtribut[2] := FAtribut[2] + 16;

if acLeftBorder in value then //byte 2 bit 3
FAtribut[2] := FAtribut[2] + 8;

// <2002-11-17> dllee &sup3;&Igrave;&laquo;á 3 bit &Agrave;&sup3;&yen;u&brvbar;&sup3; 1 &ordm;&Oslash;&iquest;&iuml;&frac34;&Uuml;
if acLeft in value then //byte 2 bit 1
FAtribut[2] := FAtribut[2] + 1
else if acCenter in value then //byte 2 bit 1
FAtribut[2] := FAtribut[2] + 2
else if acRight in value then //byte 2, bit 0 dan bit 1
FAtribut[2] := FAtribut[2] + 3
else if acFill in value then //byte 2, bit 0
FAtribut[2] := FAtribut[2] + 4;
end;

procedure TXLSWriter.WriteWord(w: word);
begin
fstream.Write(w,2);
end;

procedure TXLSWriter.WriteEOF;
begin
Writeword(BIFF_EOF);
Writeword(0);
end;

procedure TXLSWriter.WriteField(vCol, vRow: word; Field: TField);
begin
case field.DataType of
ftString,ftWideString,ftBoolean,ftDate,ftDateTime,ftTime:
Cellstr(vcol,vrow,field.asstring);
ftAutoInc,ftSmallint,ftInteger,ftWord:
CellWord(vcol,vRow,field.AsInteger);
ftFloat, ftBCD:
CellDouble(vcol,vrow,field.AsFloat);
else
Cellstr(vcol,vrow,EmptyStr); // <2002-11-17> dllee ¨&auml;&yen;L&laquo;&not;&ordm;A&frac14;g¤J&ordf;&Aring;&yen;&Otilde;&brvbar;r&brvbar;ê
end;
end;
procedure UniteXLSFiles(XLSFileNames:TStrings;DelOtherExl:Boolean = false); //合并多个excel文件
var
xlApp,NextXLApp,xlSheet,NextXLSheet,NewXLSheet,range: Variant;
i:integer;
begin
xlApp:=UnAssigned;
NextXLApp:=UnAssigned;
try
xlApp := CreateOleObject('Excel.Application');
xlApp.WorkBooks.Open(XLSFileNames[0]); //获取第一个excel文件
xlSheet:=xlApp.WorkBooks[1].WorkSheets[1]; //获取第一个Sheet
xlSheet.Name:='Sheet1';
xlApp.WorkBooks[1].save;
if XLSFileNames.Count <=1 then exit; //多于1个文件时才操作
for i:= 1 to XLSFileNames.Count -1 do
begin
try
NextXLApp := CreateOleObject('Excel.Application');
NextXLApp.WorkBooks.Open(XLSFileNames); //获取其他excel文件
NextXLApp.WorkSheets[1].Activate;
NextXLApp.ActiveSheet.UsedRange.Copy; //拷贝
NewXLSheet:=xlApp.WorkSheets.Add; //添加
NewXLSheet.PasteSpecial; //粘贴
xlApp.ActiveWorkBook.Save;
finally
NextXLApp.WorkBooks.Close;
NextXLApp.Quit;
NextXLApp := UnAssigned;
if DelOtherExl then
Deletefile(XLSFileNames);
end;
end;
finally
xlApp.WorkBooks.Close;
xlApp.Quit;
xlApp := UnAssigned;
end;
end;

end.

希望继续关注小弟的问题！

希望继续关注小弟的问题！