Утечка памяти в потоке

[StlCrash]

Ссылка на проект
Создаю поток. Все ресурсы созданные в нем освобождаю, но память все равно переполняется. Не один десяток раз проходился по коду отладчиком - БЕЗРЕЗУЛЬТАТНО. Помогите найти утечку памяти. Не один день уже бьюсь с этим кодом.

Код самого потока:

Код: Выделить всё

unit uMonThread;

interface

uses
  Forms,System.Classes, Windows, Messages, SysUtils, Variants, Graphics, Controls, Dialogs, ExtCtrls, StdCtrls, ComCtrls, mmsystem;

  type FRes = record found: boolean; x,y: integer; end;

  type
  //Для сравнения изображений (чб)
  pRGBLine=^TRGBLine;
  TRGBLine=array[word] of RGBTriple;
  TIMGData=array[word] of pRGBLine;

type
  TMonDirThread = class(TThread)
  private
    procedure checkall();
    Procedure BrowserScreen(imgW,imgH,X,Y,BlackToWhite:integer;BMP:TBitmap);
    procedure Threshold(Bitmap: TBitmap; Value: Byte; Color1, Color2: TColor);
    Procedure BMPFromDLL(bmp:TBitmap; ResName: string;BlackToWhite:integer);
    function CompareIMG(bmp1, bmp2:TBitMap): FRes;
    function ResName(Monster:string): string;
  public
  next,              //Для остановки процесса
  MonDirHello,       //здороваемся
  MonDirLS,          //ЛС
  MonDirGiExit,      //Игрок покинул гильдию
  MonDirInviteClose, //Отклонять приглашения в группы
  MonDirExitParty,   //Отряд расформирован
  MonDirDied,        //если умер
  MonDirParalich,    //контроль паралича
  MonDirMorf,        //контроль перевоплощения
  MonDirMorfSec,     //контроль перевоплощения(почти закончился)
  MonDirTotem,       //('тотем');
  MonDirRampage,     //проверка на буйство
  MonDirTimeValk,    //проверка на искажение времени
  MonDirSpeed,       //проверка на скорость
  MonDirDisconnect   //Дисконнект
  :boolean;

  nickName:string;
  n:integer;

  protected
    procedure Execute; override;
  end;

  var
  AModule: THandle;
  maxerr:integer;

implementation

procedure TMonDirThread.BMPFromDLL(bmp: TBitmap; ResName: string;
  BlackToWhite: integer);
begin
    bmp.LoadFromResourceName(AModule,ResName);
    if BlackToWhite<>900 then Threshold(bmp, BlackToWhite, clWhite, clBlack);
end;

function TMonDirThread.CompareIMG(bmp1, bmp2: TBitMap): FRes;
var
  i,y, x, yy, xx, err: integer;
  IMG1,IMG2: TIMGData;
begin
  for i:=0 to bmp1.Height-1 do IMG1[i]:=bmp1.ScanLine[i];
  for i:=0 to bmp2.Height-1 do IMG2[i]:=bmp2.ScanLine[i];
  //основной цикл по всему изображению
  y:=0;
  repeat
    x:=0;
    repeat
      //вложеный цикл по искомому фрагменту
      Result.found:=true;
      yy:=0;
      repeat
        xx:=0;
        repeat
          //если нужно точное соответствие достаточно проверить только одну компоненту
          if maxerr=0 then begin

            if IMG1[y+yy, x+xx].rgbtGreen<>IMG2[yy,xx].rgbtGreen then Result.found:=false;
          //в противном случае сначала считаем ошибку (сумму абсолютных разниц)
          end else begin
            err:=abs(IMG1[y+yy, x+xx].rgbtBlue - IMG2[yy,xx].rgbtBlue)+
                 abs(IMG1[y+yy, x+xx].rgbtGreen - IMG2[yy,xx].rgbtGreen)+
                 abs(IMG1[y+yy, x+xx].rgbtRed - IMG2[yy,xx].rgbtRed);
            //если ошибка больше допустимой, сбрасываем флаг, дальше просматривать фрагмент нету смысла
            if err>maxerr then Result.found:=false;
          end;
          inc(xx);
        until (xx>=bmp2.Width) or (Not Result.found);
        inc(yy);
      until (yy>=bmp2.Height) or (Not Result.found);
      inc(x);
    until (x>bmp1.Width-bmp2.Width) or (Result.found);
    inc(y);
  until (y>bmp1.Height-bmp2.Height) or (Result.found);
  //если флаг установлен, значит есть результат, записываем координаты верхнего левого пиксела
  if Result.found then begin
    Result.x:=x-1;
    Result.y:=y-1;
  end;

end;

procedure TMonDirThread.BrowserScreen(imgW, imgH, X, Y, BlackToWhite: integer;
  BMP: TBitmap);
var
  vDesktopDC: HDC;
begin
  vDesktopDC := GetWindowDC(GetDesktopWindow);
  try
      bmp.PixelFormat := pf24bit;
      bmp.Height := imgH;
      bmp.Width := imgW;
      BitBlt(bmp.Canvas.Handle, 0,0,imgW,imgH,vDesktopDC,X,Y,SRCCOPY);
      if BlackToWhite<>900 then Threshold(bmp,BlackToWhite,clWhite, clBlack);
  finally
    ReleaseDC(GetDesktopWindow, vDesktopDC);
end;

end;

procedure TMonDirThread.checkall;
var
  FindResult: FRes;
  s:string;
  HelloChekerBMP1,HelloChekerBMP2:TBitmap;
begin

HelloChekerBMP1:=TBitmap.Create; HelloChekerBMP2:=TBitmap.Create;


  //ЛС
  begin
    BrowserScreen(70,13,15, 644, 160, HelloChekerBMP1);
    BMPFromDLL(HelloChekerBMP2,'ls',160);
    FindResult:=CompareIMG(HelloChekerBMP1,HelloChekerBMP2);
    if FindResult.found then MonDirLS:=true else MonDirLS:=false;
  end;

  HelloChekerBMP1.free; HelloChekerBMP2.free;

[StlCrash]

Код: Выделить всё

  HelloChekerBMP1:=TBitmap.Create; HelloChekerBMP2:=TBitmap.Create;


    //Игрок покинул гильдию
  begin
    BrowserScreen(160,10,650, 410, 250, HelloChekerBMP1);
    BMPFromDLL(HelloChekerBMP2,'gildia',250);
    FindResult:=CompareIMG(HelloChekerBMP1,HelloChekerBMP2);
    if FindResult.found then MonDirGiExit:=true else MonDirGiExit:=false;
  end;

  HelloChekerBMP1.free; HelloChekerBMP2.free;
  HelloChekerBMP1:=TBitmap.Create; HelloChekerBMP2:=TBitmap.Create;

//здороваемся
  begin
  BrowserScreen(200,12,20, 644, 165, HelloChekerBMP1);
  BMPFromDLL(HelloChekerBMP2,'hi',165);
  FindResult:=CompareIMG(HelloChekerBMP1,HelloChekerBMP2);
  if FindResult.found then
      begin

        HelloChekerBMP1.free; HelloChekerBMP2.free;
        HelloChekerBMP1:=TBitmap.Create; HelloChekerBMP2:=TBitmap.Create;
      
        BrowserScreen(200,12,20, 644, 250, HelloChekerBMP1);
        BMPFromDLL(HelloChekerBMP2,ResName(nickName),250);
        FindResult:=CompareIMG(HelloChekerBMP1,HelloChekerBMP2);
         if not FindResult.found then MonDirHello:=true else MonDirHello:=false;
      end;
  end;

  HelloChekerBMP1.free; HelloChekerBMP2.free;
  HelloChekerBMP1:=TBitmap.Create; HelloChekerBMP2:=TBitmap.Create;
  
  //Отклонять приглашения в группы
  begin
    BrowserScreen(160,10,630, 360, 250, HelloChekerBMP1);
    BMPFromDLL(HelloChekerBMP2,'InviteClose',250);
    FindResult:=CompareIMG(HelloChekerBMP1,HelloChekerBMP2);
    if FindResult.found then MonDirInviteClose:=true else MonDirInviteClose:=false;
  end;

  HelloChekerBMP1.free; HelloChekerBMP2.free;
  HelloChekerBMP1:=TBitmap.Create; HelloChekerBMP2:=TBitmap.Create;
  
  //Отряд расформирован
  begin
    BrowserScreen(110,15,585, 365, 250, HelloChekerBMP1);
    BMPFromDLL(HelloChekerBMP2,'group',250);
    FindResult:=CompareIMG(HelloChekerBMP1,HelloChekerBMP2);
    if FindResult.found then MonDirExitParty:=true else MonDirExitParty:=false;
  end;

  HelloChekerBMP1.free; HelloChekerBMP2.free;

[StlCrash]

Код: Выделить всё

  HelloChekerBMP1:=TBitmap.Create; HelloChekerBMP2:=TBitmap.Create;
  
  //если умер
  begin
    BrowserScreen(40,10,540, 340, 250, HelloChekerBMP1);
    BMPFromDLL(HelloChekerBMP2,'died',250);
    FindResult:=CompareIMG(HelloChekerBMP1,HelloChekerBMP2);
    if FindResult.found then MonDirDied:=true else MonDirDied:=false;
  end;

  HelloChekerBMP1.free; HelloChekerBMP2.free;
  HelloChekerBMP1:=TBitmap.Create; HelloChekerBMP2:=TBitmap.Create;

  //контроль паралича
    begin
      BrowserScreen(303,35,970, 60, 120, HelloChekerBMP1);
      BMPFromDLL(HelloChekerBMP2,'paralich',120);
      FindResult:=CompareIMG(HelloChekerBMP1,HelloChekerBMP2);
      if FindResult.found then MonDirParalich:=true else MonDirParalich:=false;
    end;

  HelloChekerBMP1.free; HelloChekerBMP2.free;
  HelloChekerBMP1:=TBitmap.Create; HelloChekerBMP2:=TBitmap.Create;

  //контроль перевоплощения
  begin
        BrowserScreen(600,32,676, 12, 200, HelloChekerBMP1);
        BMPFromDLL(HelloChekerBMP2,'voplot',200);
        FindResult:=CompareIMG(HelloChekerBMP1,HelloChekerBMP2);
        if not FindResult.found then  MonDirMorf:=true else
          begin

            HelloChekerBMP1.free; HelloChekerBMP2.free;
            HelloChekerBMP1:=TBitmap.Create; HelloChekerBMP2:=TBitmap.Create;
  
            MonDirMorf:=false;
            BrowserScreen(50,10,676+FindResult.x-12, 12+FindResult.y+35, 250, HelloChekerBMP1);
            BMPFromDLL(HelloChekerBMP2,'voplottime',250);
            FindResult:=CompareIMG(HelloChekerBMP1,HelloChekerBMP2);
            if FindResult.found then MonDirMorfSec:=true else MonDirMorfSec:=false;
          end;
  end;

  HelloChekerBMP1.free; HelloChekerBMP2.free;
  HelloChekerBMP1:=TBitmap.Create; HelloChekerBMP2:=TBitmap.Create;
  
  //тотем
  begin
        BrowserScreen(600,32,676, 12, 220, HelloChekerBMP1);
        BMPFromDLL(HelloChekerBMP2,'totem',220);
        FindResult:=CompareIMG(HelloChekerBMP1,HelloChekerBMP2);
        if not FindResult.found then MonDirTotem:=true else MonDirTotem:=false;
  end;

  HelloChekerBMP1.free; HelloChekerBMP2.free;
  HelloChekerBMP1:=TBitmap.Create; HelloChekerBMP2:=TBitmap.Create;
  
    //проверка на буйство
  begin
        BrowserScreen(600,32,676, 12, 120, HelloChekerBMP1);
        BMPFromDLL(HelloChekerBMP2,'rampage1',120);
        FindResult:=CompareIMG(HelloChekerBMP1,HelloChekerBMP2);
        if not FindResult.found then MonDirRampage:=true else MonDirRampage:=false;
  end;

  HelloChekerBMP1.free; HelloChekerBMP2.free;
  HelloChekerBMP1:=TBitmap.Create; HelloChekerBMP2:=TBitmap.Create;

  //проверка на искажение времени
  begin
        BrowserScreen(600,32,676, 12, 220, HelloChekerBMP1);
        BMPFromDLL(HelloChekerBMP2,'timevalk',220);
        FindResult:=CompareIMG(HelloChekerBMP1,HelloChekerBMP2);
        if not FindResult.found then MonDirTimeValk:=true else MonDirTimeValk:=false;
  end;

  HelloChekerBMP1.free; HelloChekerBMP2.free;
  HelloChekerBMP1:=TBitmap.Create; HelloChekerBMP2:=TBitmap.Create;

  //проверка на скорость
  begin
        BrowserScreen(600,32,676, 12, 180, HelloChekerBMP1);
        BMPFromDLL(HelloChekerBMP2,'speed',180);
        FindResult:=CompareIMG(HelloChekerBMP1,HelloChekerBMP2);
        if not FindResult.found then  MonDirSpeed:=true else  MonDirSpeed:=false;
  end;

  HelloChekerBMP1.free; HelloChekerBMP2.free;
  HelloChekerBMP1:=TBitmap.Create; HelloChekerBMP2:=TBitmap.Create;

  //Дисконнект
  begin
    s:='discinnect';
    BrowserScreen(90,10,650, 410, 250, HelloChekerBMP1);
    BMPFromDLL(HelloChekerBMP2,s,250);
    FindResult:=CompareIMG(HelloChekerBMP1,HelloChekerBMP2);
    if not FindResult.found then
    begin

    HelloChekerBMP1.free; HelloChekerBMP2.free;
    HelloChekerBMP1:=TBitmap.Create; HelloChekerBMP2:=TBitmap.Create;
    
      s:='discinnect1';
      BrowserScreen(90,10,650, 410, 250, HelloChekerBMP1);
      BMPFromDLL(HelloChekerBMP2,s,250);
      FindResult:=CompareIMG(HelloChekerBMP1,HelloChekerBMP2);
    end;
    if FindResult.found then  MonDirDisconnect:=true else  MonDirDisconnect:=false
  end;

  HelloChekerBMP1.free; HelloChekerBMP2.free;
end;

[StlCrash]

Код: Выделить всё

procedure TMonDirThread.Execute;
begin
  { Place thread code here }
  maxerr:=0;
  AModule := LoadLibrary('res.dll');
  next:=true;

  MonDirHello:=false;       //здороваемся
  MonDirLS:=false;          //ЛС
  MonDirGiExit:=false;      //Игрок покинул гильдию
  MonDirInviteClose:=false; //Отклонять приглашения в группы
  MonDirExitParty:=false;   //Отряд расформирован
  MonDirDied:=false;        //если умер
  MonDirParalich:=false;    //контроль паралича
  MonDirMorf:=false;        //контроль перевоплощения
  MonDirMorfSec:=false;     //контроль перевоплощения(почти закончился)
  MonDirTotem:=false;       //('тотем');
  MonDirRampage:=false;     //проверка на буйство
  MonDirTimeValk:=false;    //проверка на искажение времени
  MonDirSpeed:=false;       //проверка на скорость
  MonDirDisconnect:=false;   //Дисконнект

  while next do begin
    checkall;
    n:=n+1;
    sleep(100);
  end;

  FreeLibrary(AModule);
end;

function TMonDirThread.ResName(Monster: string): string;
begin
  if Monster='Гоблин-шахтер' then begin result:='goblinshacter'; exit; end;
  if Monster='Ящер огня' then begin result:='yasherogna'; exit; end;
  if Monster='Мантикора' then begin result:='manticora'; exit; end;
  if Monster='Дикарь' then begin result:='dicar'; exit; end;
  if Monster='Камень чакры' then begin result:='chacra'; exit; end;
  if Monster='Слизь' then begin result:='sliz'; exit; end;
  if Monster='Рак-отшельник' then begin result:='rakotshel'; exit; end;
  if Monster='Личинка' then begin result:='lichinka'; exit; end;

  if Monster='Внешний лагерь' then begin result:='homeHM'; exit; end;
  if Monster='Дом Гильдии' then begin result:='home'; exit; end;
  if Monster='Деревня Эшборн' then begin result:='eshborn'; exit; end;
  if Monster='Деревня Байрон' then begin result:='bairon'; exit; end;
  if Monster='Деревня Роден' then begin result:='roden'; exit; end;
  if Monster='Деревня Темных земель' then begin result:='darkearth'; exit; end;
  if Monster='Арена Гильдий' then begin result:='arena'; exit; end;

  if Monster='Сум основа' then begin result:='crash'; exit; end;
  if Monster='Сум твинк' then begin result:='crash1'; exit; end;
  if Monster='Маг' then begin result:='nick'; exit; end;
end;

procedure TMonDirThread.Threshold(Bitmap: TBitmap; Value: Byte; Color1,
  Color2: TColor);
type TRGB = record B, G, R: Byte; end; pRGB = ^TRGB;
function ColorToRGB(Color: TColor): TRGB;
  begin
  with Result do
    begin
      R := Lo(Color);
      G := Lo(Color shr 8);
      B := Lo((Color shr 8) shr 8);
    end;
  end;
var x, y: Word; C1, C2: TRGB; Dest: pRGB;
begin
Bitmap.PixelFormat := pf24Bit;
C1 := ColorToRGB(Color1);
C2 := ColorToRGB(Color2);
for y := 0 to Bitmap.Height - 1 do
  begin
    Dest := Bitmap.ScanLine[y];
    for x := 0 to Bitmap.Width - 1 do
      begin
        if (Dest^.r + Dest^.g + Dest^.b) / 3 > Value then Dest^ := C1 else Dest^ := C2; Inc(Dest);
      end;
  end;
end;
end.