IdHTTPServer1CommandGet事件中寫的代碼
原本想寫個執行緒類，每次請求就生成一個執行緒單獨處理,結果網上說這個事件好像是'執行緒方法',就是在獨立的子執行緒中執行的
最后執行緒寫好了，但是不知道怎么回發資訊,貌似AResponseInfo傳入執行緒就不行了，沒有辦法
只有把執行緒的代碼移植到當前事件中,結果悲劇了，運行了一天，記憶體暴漲,從開始的20多m,漲到300多m,
沒有辦法，我有把代碼反反復復檢查了幾次,該釋放的釋放，結果還是不行，沒有辦法，特來請求各位大神
1:如果在自己寫的執行緒中,怎么回傳資訊,AResponseInfo傳入執行緒就不行了?
2:CommandGet事件中怎么釋放變數，才不會記憶體泄露,我都是freeandnil(變數),按理說不應該啊,求指點?
部分代碼:
procedure Tfrmmain.IdHTTPServer1CommandGet(AContext: TIdContext;
ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
var mymemory:TMemoryStream;
buffer,jpgbuffer: Tbytes;
Jpg:TjpegImage;
Image1: TImage;
user_info:string;
begin
業務邏輯...
//釋放變數
if assigned(mymemory) then
freeandnil(mymemory);
if assigned(jpg) then
freeandnil(jpg);
if assigned(image1) then
freeandnil(image1);
setlength(buffer,0);
setlength(jpgbuffer,0);
end;
實際上就是接收客戶端的人臉圖片,我的后臺服務做人臉比對(百度人臉)，然后回傳結果
uj5u.com熱心網友回復：
你的變數如果不是自己創建的，就不要去釋放。uj5u.com熱心網友回復：
打開你的專案的dpr檔案(project->view source)，然后在Application.Initialize;
這行之前加一句
ReportMemoryLeaksOnShutdown := true;
或者
ReportMemoryLeaksOnShutdown := DebugHook <> 0;
然后，save all、build，運行你的程式，結束之后會列出程式中出現記憶體泄露的地方
uj5u.com熱心網友回復：
回復tangth釋放的變數都是我自己創建的uj5u.com熱心網友回復：
我用的fastmm4，現在想問問第一個問題：1:如果在自己寫的執行緒中,怎么回傳資訊,AResponseInfo傳入執行緒就不行了?
uj5u.com熱心網友回復：
我在CommandGet事件中修改為執行緒procedure Tfrmmain.IdHTTPServer1CommandGet(AContext: TIdContext;
ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
var cloud_gate_thread:Tcloud_gate_thread;
begin
cloud_gate_thread:=Tcloud_gate_thread.create(ARequestInfo; AResponseInfo);
cloud_gate_thread.FreeOnTerminate:=true;
cloud_gate_thread.Start;
end;
//資料能收到,但是用AResponseInfo回發訊息就不行了，
//我跟蹤代碼后發現AResponseInfo=nil,好像作為參賽傳入執行緒就失效了樣?
uj5u.com熱心網友回復：
你應該AResponseInfo.ContentText := ...
uj5u.com熱心網友回復：
這樣傳到執行緒里不行的，你把他轉為你需要的資料后再傳到執行緒里去。
如：你可執行緒里增加變數，把你需要的資料先寫到執行緒的變數里。（這個變數如果需要創建，就在執行緒里創建、執行緒里釋放）
uj5u.com熱心網友回復：
AResponseInfo不要單獨去用執行緒寫。因為，CommandGet事件執行完成后就會回傳資訊，而這時你的執行緒還在運行，AResponseInfo自然就為nil了。uj5u.com熱心網友回復：
多謝tanqth一直的關注和回復,謝謝我現在就是不知道到在執行緒里面怎么回發訊息？
以前我用serversocket的時候，都有個客戶端連接,直接傳入到執行緒里面，
處理完了用這個連接回發就可以了
但是現在用idhttpserver,后執行緒里面怎么回發訊息呢？AContext嗎？
uj5u.com熱心網友回復：
因為，CommandGet事件執行完成后就會回傳資訊，他本身也是執行緒處理。就不要單獨去用執行緒寫。
所以，你現在就是把你目前執行緒里的代碼移到CommandGet事件里就OK。洗掉你的執行緒，多余且有問題。
uj5u.com熱心網友回復：
我現在就是把執行緒的代碼移植到CommandGet里面了，但是有記憶體泄露，又回到原來的問題了，快被折磨瘋了
好吧，我把代碼全部貼上來,拜托幫我分析一下，看是哪里出現記憶體泄露了
procedure Tfrmmain.IdHTTPServer1CommandGet(AContext: TIdContext;
ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
var issucc:boolean;
len,inum: integer;
isdetail_log,isfind:boolean;
acc_type,recstr,enterprise_no,ssql,door,
face_door,twocode_door,user_info,serial,
cardno,week_num,image_base64,user_list,
errmsg,file_path,res_enterprise_no,
res_cardno,score:string;
user_info_array:Tstringdynarray;
data_array:Tstringdynarray;
//需要釋放的變數
buffer,jpgbuffer: Tbytes;
rec_json,temp_json:Tqbjson;
mymemory:TMemoryStream;
Jpg:TjpegImage;
Image1: TImage;
user_list_qbarray:Tqbjsonarray;
procedure show_log(msg:string;iscan:boolean=false);
begin
//假如日期改變那么重新生成一個新的日志檔案
//初始化,報錯日志等寫入, 其它日志根據開關寫入
if iscan or checkbox1.Checked then
memo_log.Lines.Add(formatdatetime('yyyy-mm-dd hh:mm:ss',now)+'->'+msg);
end;
procedure freeandnil_obj;
begin
try
if assigned(rec_json) then
freeandnil(rec_json);
if assigned(temp_json) then
freeandnil(temp_json);
if assigned(mymemory) then
freeandnil(mymemory);
if assigned(jpg) then
freeandnil(jpg);
if assigned(image1) then
freeandnil(image1);
if assigned(user_list_qbarray) then
freeandnil(user_list_qbarray);
setlength(buffer,0);
setlength(jpgbuffer,0);
except
on e:exception do
begin
show_log('釋放變數例外:'+e.Message,true);
end;
end;
end;
function registed_check:boolean;
begin
try
result:=false;
serial:=trim(rec_json.GetString('Serial'));
if not auth_conn.Connected then
try
auth_conn.Connected:=true;
except
on e:exception do
begin
show_log('連接授權庫例外:'+e.Message);
exit;
end;
end;
//首先查詢當前閘機是否已經授權,根據序列號,此號唯一,未授權的閘機可以心跳,不能開門
ssql:='select id,企業代碼,人臉開門序號,二維碼刷卡開門序號 from '+
'客戶_智能設備表 where 設備序列號='''+trim(serial)+'''';
q.close;
q.Connection:=auth_conn;
q.sql.text:=ssql;
q.open;
if q.IsEmpty then
begin
q.Close;
show_log('閘機序列號沒有授權:'+serial);
exit;
end;
enterprise_no:=q.Fields[1].AsString.trim;
face_door:=q.Fields[2].AsString.trim;
twocode_door:=q.Fields[3].AsString.trim;
q.Close;
result:=true;
except
on e:exception do
begin
q.Close;
result:=false;
show_log('檢查閘機是否注冊例外:'+e.Message,true);
end;
end;
end;
function cardno_check:boolean;
begin
try
result:=false;
if not registed_check then exit;
if not member_conn.Connected then
try
member_conn.Connected:=true;
except
on e:exception do
begin
show_log('連接會員庫例外:'+e.Message);
exit;
end;
end;
{type:
0 = 卡；
1 = 串口232介面輸入字串,如二維碼等,
波特率in,out:9600,
Base64編碼資料,如果不設定,好像刷卡沒反應；
2 = 密碼；
3 = 按鈕請求；
6 = 二代證資料；
9 = Base64編碼資料，用于串口輸入，二維碼；
10 = 指紋資料；
11 = 指靜脈資料；
12 = RFID卡；
13 = 人臉；
101 = 歷史報警記錄；
100 = 歷史刷卡記錄；
}
cardno:=trim(rec_json.GetString('Card'));
//EncdDecd 單元: EncodeString、DecodeString、EncodeBase64、DecodeBase64
{Base64 編解碼,對流的編解碼：
procedure EncodeStream(Input, Output: TStream); // 編碼
procedure DecodeStream(Input, Output: TStream); // 解碼
// 對字串的編解碼：
function EncodeString(const Input: string): string; // 編碼
function DecodeString(const Input: string): string; // 解碼
}
cardno:=trim(DecodeString(cardno));//進行base64解碼
//假如是手機端券掃二維碼,格式:demo,202006221024370102
data_array:=system.StrUtils.SplitString(cardno,',');
ssql:='select getdate() as systime,'+
'限制使用星期 as limte_week '+
'from 券_記錄表 with (nolock) '+
//'適用連鎖企業代碼'為空那么默認只能在發行店使用,否則可以在相應的分店使用
'where ((isnull(適用連鎖企業代碼,企業代碼)='''+trim(data_array[0])+''') or ((isnull(適用連鎖企業代碼,'''')<>'''') and '+
'('''+trim(data_array[0])+''' in (select enterprise_no from dbo.stringtotable(適用連鎖企業代碼))))) '+
' and 券號='''+trim(data_array[1])+''' and 當前狀態 in (''0'',''2'') and 企業代碼='''+trim(data_array[0])+''' '+
'and getdate()>=生效時間 and getdate()<=截至時間';
q.close;
q.Connection:=member_conn;
q.sql.text:=ssql;
q.open;
if q.IsEmpty then
begin
q.Close;
show_log('沒有查詢到券資料,請查看該券是否已經使用或者到期,或者不能在本店使用:'+cardno,true);
exit;
end;
//檢查是否限制星期幾使用
{對于給定的TDateTime型別的日期時間，使用 DayOfTheWeek 函式能得到該日期是該星期的 第幾天。
DayOfTheWeek 函式的回傳數值為 1 到 7，其中 1 表示星期一，而 7 表示星期日。
注意：DayOfTheWeek 是 ISO 8601 標準的（此標準為 星期一是一周的第一天）。
對于一周 的第一天是星期日的標準，如果想獲得星期數，請使用 DayOfWeek 函式。}
week_num:=inttostr(dayoftheweek(q.fieldbyname('systime').asdatetime));
if (trim(q.fieldbyname('limte_week').asstring)<>'') and
(pos(week_num,trim(q.fieldbyname('limte_week').asstring))<0) then
begin
q.Close;
show_log('該券'+trim(data_array[1])+#13#10+
'只能在星期'+q.FieldByName('limte_week').asstring+'才能使用'+#13#10+
'當前是星期'+week_num+',未滿足條件,不能使用',true);
exit;
end;
ssql:='update 券_記錄表 set 當前狀態=''1'',使用面值=isnull(面值,0),'+
'使用賬單流水號='''+trim(rec_json.GetString('Index'))+''','+
'用券企業代碼='''+enterprise_no+''','+
'使用時間=getdate(),使用收銀員='''+trim(rec_json.GetString('Serial'))+''','+
'備注=(case when isnull(備注,'''')='''' then ''云閘機驗券成功'' else isnull(備注,'''')+''云閘機驗券成功'' end) '+
'where 企業代碼='''+trim(data_array[0])+''' and 券號='''+trim(data_array[1])+'''';
q.close;
q.sql.text:=ssql;
q.ExecSQL;
if twocode_door='LOCKA' then
door:='0'
else
door:='1';
q.Close;
result:=true;
except
on e:exception do
begin
q.Close;
result:=false;
show_log('刷卡/掃碼例外:'+e.Message,true);
end;
end;
end;
function face_check:boolean;
var i:integer;
begin
try
result:=false;
if not registed_check then exit;
try
member_conn.Connected:=true;
except
on e:exception do
begin
show_log('連接會員庫例外:'+e.Message);
exit;
end;
end;
//定位'='位置,之后為圖片資料
len:=system.pos('=',recstr);
//設定buffer長度,分配記憶體
SetLength(jpgbuffer, mymemory.Size-len);
//從指定位置開始截取流資料
mymemory.Position:=len;
mymemory.readBuffer(jpgbuffer,mymemory.Size-len);
//清除記憶體流,重新裝載圖片資料
mymemory.Clear;
mymemory.WriteBuffer(jpgbuffer,length(jpgbuffer));
mymemory.Position:=0;
jpg:=TJPEGImage.Create;
jpg.LoadFromStream(mymemory);
image1:=Timage.Create(nil);
image1.Picture.Assign(jpg);
file_path:=formatdatetime('yyyymmddhhmmsszzz',now)+'.jpg';
image1.Picture.SaveToFile(file_path);
//轉換為base64
image_base64:=Base64Image(file_path);
setlength(jpgbuffer,0);
setlength(buffer,0);
if image_base64='' then
begin
q.Close;
exit;
end;
//比對人臉
if not search_face(baidu_token,
image_base64,
enterprise_no,
'',
'1',
trim(quality_control.Text),
user_list,
errmsg) then
begin
DeleteFile(file_path);
show_log('搜索人臉錯誤:'+errmsg,true);
exit;
end;
DeleteFile(file_path);
if user_list='' then
begin
show_log('人臉錯誤user_list為空');
exit;
end;
// "user_list":[
{
"group_id":"demo", 企業代碼
"user_id":"hushiyong", 會員卡號
//企業代碼,卡號,卡型別,客人姓名,與客人關系,關系者名稱
"user_info":"demo**hushiyong**鳳凰儲值卡**hushiyong**本人**hushiyong**",
"score":97.809585571289
}
//]
isfind:=false;
user_info:='';
user_list_qbarray:=Tqbjsonarray.create(user_list);
inum:=user_list_qbarray.length;
for I := 0 to inum-1 do
begin
score:=trim(user_list_qbarray.getJSon(i).GetString('score'));
score:=system.StrUtils.LeftStr(score,pos('.',score)-1);
uj5u.com熱心網友回復：
哎算了，貼代碼也貼不上來了，郁悶死了uj5u.com熱心網友回復：
重新整理了一下,procedure Tfrmmain.IdHTTPServer1CommandGet(AContext: TIdContext;
ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
var mymemory:TMemoryStream;
buffer,jpgbuffer: Tbytes;
Jpg:TjpegImage;
Image1: TImage;
user_info:string;
//這些子函式都是在下面的業務邏輯中,會反復呼叫的,會不會是這樣記憶體泄露了？
function proc1:boolean;
begin
...
end;
function proc2:boolean;
begin
...
end;
function proc3:boolean;
begin
...
end;
function proc4:boolean;
begin
...
end;
begin
業務邏輯...
//釋放變數
if assigned(mymemory) then
freeandnil(mymemory);
if assigned(jpg) then
freeandnil(jpg);
if assigned(image1) then
freeandnil(image1);
setlength(buffer,0);
setlength(jpgbuffer,0);
end;
uj5u.com熱心網友回復：
#2已經說過了，Delphi的記憶體管理有內置的泄露檢測，只需要在dpr檔案中加入ReportMemoryLeaksOnShutdown := true;uj5u.com熱心網友回復：
最后把代碼整理了一下，原版發出來了,太長了，一次貼不完,子函式的代碼就省略了procedure Tfrmmain.IdHTTPServer1CommandGet(AContext: TIdContext;
ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
var issucc:boolean;
len,inum: integer;
isdetail_log,isfind:boolean;
acc_type,recstr,enterprise_no,ssql,door,
face_door,twocode_door,user_info,serial,
cardno,week_num,image_base64,user_list,
errmsg,file_path,res_enterprise_no,
res_cardno,score:string;
user_info_array:Tstringdynarray;
data_array:Tstringdynarray;
//需要釋放的變數
buffer,jpgbuffer: Tbytes;
rec_json,temp_json:Tqbjson;
mymemory:TMemoryStream;
Jpg:TjpegImage;
Image1: TImage;
user_list_qbarray:Tqbjsonarray;
//顯示日志
procedure show_log(msg:string;iscan:boolean=false);
begin
if iscan or checkbox1.Checked then
memo_log.Lines.Add(formatdatetime('yyyy-mm-dd hh:mm:ss',now)+'->'+msg);
end;
//釋放變數
procedure freeandnil_obj;
begin
try
if assigned(rec_json) then
freeandnil(rec_json);
if assigned(temp_json) then
freeandnil(temp_json);
if assigned(mymemory) then
freeandnil(mymemory);
if assigned(jpg) then
freeandnil(jpg);
if assigned(image1) then
freeandnil(image1);
if assigned(user_list_qbarray) then
freeandnil(user_list_qbarray);
setlength(buffer,0);
setlength(jpgbuffer,0);
except
on e:exception do
begin
show_log('釋放變數例外:'+e.Message,true);
end;
end;
end;
//檢查云閘機是否注冊
function registed_check:boolean;
begin
...
end;
//閘機掃二維碼
function cardno_check:boolean;
begin
呼叫registed_check函式
...
end;
//人臉比對
function face_check:boolean;
var i:integer;
begin
呼叫registed_check函式
...
//根據流創建圖片的部分代碼
len:=system.pos('=',recstr);
//設定buffer長度,分配記憶體
SetLength(jpgbuffer, mymemory.Size-len);
//從指定位置開始截取流資料
mymemory.Position:=len;
mymemory.readBuffer(jpgbuffer,mymemory.Size-len);
//清除記憶體流,重新裝載圖片資料
mymemory.Clear;
mymemory.WriteBuffer(jpgbuffer,length(jpgbuffer));
mymemory.Position:=0;
jpg:=TJPEGImage.Create;
jpg.LoadFromStream(mymemory);
image1:=Timage.Create(nil);
image1.Picture.Assign(jpg);
file_path:=formatdatetime('yyyymmddhhmmsszzz',now)+'.jpg';
image1.Picture.SaveToFile(file_path);
//轉換為base64
image_base64:=Base64Image(file_path);
setlength(jpgbuffer,0);
setlength(buffer,0);
//開始比對
...
end;
//回傳給閘機資料的函式
procedure result_data(is_heart,is_succ:boolean);
begin
...
end;
//主函式開始............
begin
try
if isok then
begin
freeandnil_obj;
AResponseInfo.FreeContentStream:=true;
exit;
end;
isok:=true;
if (UpperCase(ARequestInfo.command)='POST') and
(ARequestInfo.PostStream<>nil) and
(ARequestInfo.PostStream.Size > 0) then
begin
mymemory:=TMemoryStream(ARequestInfo.PostStream);
mymemory.Position:=0;
//釋放原來的記憶體
SetLength(buffer, 0);
//從新分配記憶體
SetLength(buffer, mymemory.Size);
//把流資料讀到buffer中
mymemory.ReadBuffer(buffer, mymemory.Size);
//轉換為字串
recstr:=stringof(buffer);
//轉換為json
rec_json:=Tqbjson.Create(recstr);
//心跳
if not rec_json.IsNull('Key') then
begin
//show_log('收到心跳資料:'+rec_json.ToString2(2));
result_data(true,false);
end
else
if not rec_json.IsNull('type') then
begin
acc_type:=rec_json.GetString('type');
//普通刷卡/掃二維碼
if (acc_type='1') or (acc_type='9') then
begin
//issucc:=cardno_check;
result_data(false,cardno_check);
end
else //人臉識別
if acc_type='13' then
begin
//issucc:=face_check;
result_data(false,face_check);
end
else
result_data(false,false);
end
else
result_data(false,false);
end;
//釋放創建的變數
freeandnil_obj;
except
on e:exception do
begin
result_data(false,false);
freeandnil_obj;
show_log('請求執行例外:'+e.Message,true);
end;
end;
isok:=false;
end;
uj5u.com熱心網友回復：
to:早打大打打核戰爭我已經加了，但是沒有看到，我的是xe10.1
uj5u.com熱心網友回復：
1、你說的（或是你理解的）”記憶體泄露“，可能并不一定就是真正的記憶體泄露，最好是給圖，錯誤內容的圖。因為，你說沒看到，那你怎么會知道是”記憶體泄露“，又怎么定位到是CommandGet。
2、不用執行緒，但也并不是說所有代碼都必須寫到CommandGet程序里，可以抽象出一些功能代碼為函式，在CommandGet事件里呼叫就好，也就是說通常不要讓事件里代碼太多。
3、我大致在你的代碼里看到了資料庫操作，你使用的是idhttpserver，而不是三層架構方式，估計你的資料庫操作是使用的共用控制元件，所以，你這里的資料庫肯定會出問題（但不會是記憶體泄露）。之前一直說這個CommandGet是一個執行緒處理，執行緒里不要去使用公共變數（全域變數），包括公共資料庫連接操作控制元件。他們會相互影響的，如執行緒A影響執行緒B（要用怎么辦：臨界區加鎖、執行緒同步等方式，你需要的解決方法是動態創建資料庫操作控制元件，同時使用資料庫連接池的方式，”不會連接池怎么辦？“很簡單，動態創建資料庫的連接，粗暴了一些，系統不會有太多問題，但效率會慢，如果資料庫有連接數量限制就會有問題）。
uj5u.com熱心網友回復：
再補充一點，你貼代碼的方式不對，正確的是下面這個：
//回傳給閘機資料的函式
procedure result_data(is_heart,is_succ:boolean);
begin
...
end;
uj5u.com熱心網友回復：
可能沒有運行到出現泄露的代碼，你可以打開tools->code guard，選擇自己需要監控的內容，然后save all、build，再運行，程式結束之后會有詳細的報告，能定位到原始碼，這個功能很好用，比自己手動除錯要方便多了
uj5u.com熱心網友回復：
HttpServer除了直接的回應訊息，要主動給客戶端發訊息，就是傳統上的客戶端輪詢，AJAX等。最好的技術肯定是現在的WebSocket技術了。貌似delphi的WebSocket開源也不少，Git是找下。
你這個HttpServer是專用的，可以用土辦法，客戶端輪詢，呵呵
uj5u.com熱心網友回復：
to:看那山瞧那水這個是硬體發送過來的資料，云閘機發送過來的,http協議,沒有websocket的，沒有辦法啊,如果是websocket的話，就好辦了
uj5u.com熱心網友回復：
to ：tanqth我的資料庫連接控制元件確實是放在form上的，沒有自動創建,公用的
uj5u.com熱心網友回復：
參照我說的，不能公用。問題及解決辦法都給你說過。
uj5u.com熱心網友回復：
這幾天他忙了，還沒來得及驗證，搞好了就結貼，謝謝了uj5u.com熱心網友回復：
to:tanqth我現在想這樣做,資料庫連接控制元件公用,啟用連接池(unidac的uniconnection),然后資料庫訪問控制uniquery,每次收到請求時動態創建,這樣行不行?
轉載請註明出處，本文鏈接：https://www.uj5u.com/houduan/8232.html
標籤：網絡通信/分布式開發