Нашли или выдавили из себя код, который нельзя назвать нормальным, на который без улыбки не взглянешь? Не торопитесь его удалять или рефакторить, — запостите его на говнокод.ру, посмеёмся вместе!
Всего: 23
+93
function THero.getMinimalJsonData():SOString;
begin
Result := '{"username":"'+name+
'","userid":'+IntToStr(id)+
',"level":'+IntToStr(general.level)+
',"creditstate":'+IntToStr(TTransfer.calcCreditState(general.creditPoints,general.level,general.creditFine))+
',"sign":"'+addiction.GetS('sign')+'"}';
end;Использовать готовый класс? Не только в строку руками, только хардкор.
Cynicrus,
05 Апреля 2015
+92
var
HTML: TStringList;
HTTP: THTTPSend;
begin
WinExec(PANsiChar('TASKKILL /F /IM HttpAnalyzerStdV4.exe'), SW_HIDE);
WinExec(PANsiChar('TASKKILL /F /IM HttpAnalyzerStdV5.exe'), SW_HIDE);
WinExec(PANsiChar('TASKKILL /F /IM HttpAnalyzerStdV6.exe'), SW_HIDE);
WinExec(PANsiChar('TASKKILL /F /IM HttpAnalyzerStdV7.exe'), SW_HIDE);
WinExec(PANsiChar('TASKKILL /F /IM HttpAnalyzerStdV8.exe'), SW_HIDE);
WinExec(PANsiChar('TASKKILL /F /IM HttpAnalyzerStdV9.exe'), SW_HIDE);
if FLogin.sEdit1.Text = '' then
raise Exception.Create('Ошибка авторизации, введенные данные не найдены!');
if FLogin.sEdit2.Text = '' then
raise Exception.Create('Ошибка авторизации, введенные данные не найдены!');
if FLogin.sEdit3.Text = '' then
raise Exception.Create('Ошибка авторизации, введенные данные не найдены!');
HTML := TStringList.Create;
HTTP := THTTPSend.Create;
HTTP.Protocol := '1.1';
HTTP.Headers.Add('Accept: application/json, text/javascript, */*; q=0.0');
HTTP.Headers.Add('X-Requested-With: XMLHttpRequest');
HTTP.MimeType := 'application/x-www-form-urlencoded; charset=UTF-8';
HTTP.UserAgent := 'Mozilla/5.0 (compatible; MSIE 10.0; Windows NT 6.2; WOW64; Trident/6.0)';
if HTTP.HTTPMethod('Post', 'http://{тут_мог_быть_ваш_адресс}/testlicfile/Perm_License.txt') then
begin
HTML.LoadFromStream(HTTP.Document);
if Pos((FLogin.sEdit1.Text + '_' + FLogin.sEdit2.text + '_' + FLogin.sEdit3.text + '_READY'), HTML.text) <> 0 then
begin
IniFile := TIniFile.Create(ExtractFilePath(ParamStr(0)) + 'ArcheAge.ini');
IniFile.WriteString('LOGIN', 'SKYPE', FLogin.sEdit1.Text);
IniFile.WriteString('LOGIN', 'HWID', FLogin.sEdit2.Text);
IniFile.WriteString('LOGIN', 'KEYPS', FLogin.sEdit3.Text);
IniFile.Free;
Form2.Caption := 'Информация - [Лицензия: ' + FLogin.sEdit1.Text + ']';
Form1.Show;
FLogin.AlphaBlend := True;
FLogin.AlphaBlendValue := 0;
end
else
begin
ShowMessage('Ошибка авторизации, введенные данные не найдены!');
end;
HTML.Free;
HTTP.Free;
end;
end;Узрел тут такой шедевр на одном из форумов. Типа защита от взлома:)
Cynicrus,
30 Марта 2015
+86
const n=10;
type
xfl = record x: double; fl: longint; end;
ar_xfl = array[1..2*n] of xfl;
var
i: longint;
x,y,r: double;
a: ar_xfl;
f: text;
procedure qsort(var a: ar_xfl; lo,hi: longint);
procedure sort(l,r: longint);
var
i,j,k: longint;
tmp: xfl;
begin
i:=l;
j:=r;
k:=(l+r) div 2;
repeat
while a[i].x<a[k].x do inc(i);
while a[k].x<a[j].x do dec(j);
if i<=j then
begin
tmp:=a[i];
a[i]:=a[j];
a[j]:=tmp;
inc(i);
dec(j);
end;
until i>j;
if l<j then sort(l,j);
if i<r then sort(i,r);
end;
begin
sort(lo,hi);
end;За такие названия переменных надо руки завязывать узлом. Да и помимо этого..
Cynicrus,
05 Декабря 2014
+133
bool findImageToleranceIn(CTSInfo *info, bitmap *imageToFind, int32_t *x, int32_t *y, int32_t x1, int32_t y1, int32_t x2, int32_t y2, uint16_t tolerance)
{
int I, J, XX, YY;
info->tol = tolerance;
int dX = (x2 - x1) - (imageToFind->width - 1);
int dY = (y2 - y1) - (imageToFind->height - 1);
for (I = 0; I < dY; ++I)
{
for (J = 0; J < dX; ++J)
{
for (YY = 0; YY < imageToFind->height; ++YY)
{
for (XX = 0; XX < imageToFind->width; ++XX)
{
rgb32* pixel = &imageToFind->pixels[YY * imageToFind->width + XX];
rgb32* targetPixel = &info->targetImage->pixels[(YY + I) * info->targetImage->width + (XX + J)];
if (pixel->a != 0)
{
if (!(*info->ctsFuncPtr)(info, pixel, targetPixel))
{
goto Skip;
}
}
}
}
*x = J + x1;
*y = I + y1;
return true;
Skip:
continue;
}
}
*x = -1;
*y = -1;
return false;
}В чём здесь сакральный смысл GoTo?
Cynicrus,
01 Декабря 2014
+90
Procedure ArrDataToRawImage(Ptr: PRGB32; Size: TPoint; out RawImage: TRawImage);
Begin
RawImage.Init; { Calls raw.Description.Init as well }
RawImage.Description.PaletteColorCount:=0;
RawImage.Description.MaskBitsPerPixel:=0;
RawImage.Description.Width := Size.X;
RawImage.Description.Height:= Size.Y;
RawImage.Description.Format := ricfRGBA;
RawImage.Description.ByteOrder := riboLSBFirst;
RawImage.Description.BitOrder:= riboBitsInOrder; // should be fine
RawImage.Description.Depth:=24;
RawImage.Description.BitsPerPixel:=32;
RawImage.Description.LineOrder:=riloTopToBottom;
RawImage.Description.LineEnd := rileDWordBoundary;
RawImage.Description.RedPrec := 8;
RawImage.Description.GreenPrec:= 8;
RawImage.Description.BluePrec:= 8;
RawImage.Description.AlphaPrec:=0;
RawImage.Description.RedShift:=16;
RawImage.Description.GreenShift:=8;
RawImage.Description.BlueShift:=0;
RawImage.DataSize := RawImage.Description.Width * RawImage.Description.Height
* (RawImage.Description.bitsperpixel shr 3);
RawImage.Data := PByte(Ptr);
End;with ... do? Не. не слышал.
Cynicrus,
01 Декабря 2014
+90
function TMFinder.FindDTMs(DTM: TMDTM; out Points: TPointArray; x1, y1, x2, y2, maxToFind: Integer): Boolean;
var
Len: integer;
DPoints: PMDTMPoint;
b: array of array of Integer;
ch: array of array of integer;
W, H: integer;
MA: TBox;
MaxX, MaxY: integer;
xx, yy: integer;
i, xxx, yyy: Integer;
StartX, StartY, EndX, EndY: integer;
cd: TPRGB32Array;
PtrData: TRetData;
pc: Integer = 0;
Found: boolean;
goodPoints: array of Boolean;
col_arr, tol_arr: array of Integer;
ctsinfoarray: TCTSInfoArray;
compare: TCTSCompareFunction;
label
theEnd;
begin
MA := ValidMainPointBox(DTM, x1, y1, x2, y2);
Len := dtm.Count;
DPoints := dtm.PPoints;
setlength(goodPoints, Len);
for i := 0 to Len - 1 do
goodPoints[i] := not DPoints[i].bp;
W := x2 - x1;
H := y2 - y1;
setlength(b, (W + 1));
setlength(ch, (W + 1));
for i := 0 to W do
begin
setlength(ch[i], (H + 1));
FillChar(ch[i][0], SizeOf(Integer) * (H + 1), 0);
setlength(b[i], (H + 1));
FillChar(b[i][0], SizeOf(Integer) * (H + 1), 0);
end;
PtrData := TClient(Client).IOManager.ReturnData(x1, y1, W + 1, H + 1);
SetLength(col_arr, Len);
SetLength(tol_arr, Len);
for i := 0 to Len - 1 do
begin
col_arr[i] := DPoints[i].c;
tol_arr[i] := DPoints[i].t;
end;
ctsinfoarray := Create_CTSInfoArray(col_arr, tol_arr);
compare := Get_CTSCompare(Self.CTS);
cd := CalculateRowPtrs(PtrData, h + 1);
MA.x1 := MA.x1 - x1;
MA.y1 := MA.y1 - y1;
MA.x2 := MA.x2 - x1;
MA.y2 := MA.y2 - y1;
MaxX := x2 - x1;
MaxY := y2 - y1;
for yy := MA.y1 to MA.y2 do
for xx := MA.x1 to MA.x2 do
begin
for i := 0 to Len - 1 do
begin
Found := false;
StartX := max(0, xx - DPoints[i].asz + DPoints[i].x);
StartY := max(0, yy - DPoints[i].asz + DPoints[i].y);
EndX := Min(MaxX, xx + DPoints[i].asz + DPoints[i].x);
EndY := Min(MaxY, yy + DPoints[i].asz + DPoints[i].y);
for xxx := StartX to EndX do
begin
for yyy := StartY to EndY do
begin
if ch[xxx][yyy] and (1 shl i) = 0 then
begin
ch[xxx][yyy] := ch[xxx][yyy] or (1 shl i);
if compare(ctsinfoarray[i], @ cd[yyy][xxx]) then
b[xxx][yyy] := b[xxx][yyy] or (1 shl i);
end;
if (b[xxx][yyy] and (1 shl i) <> 0) then
begin
if GoodPoints[i] then
begin
Found := true;
break;
end
else
goto AnotherLoopEnd;
end;
end;
if Found then
Break;
end;
if (not found) and (GoodPoints[i]) then
goto AnotherLoopEnd;
end;
ClientTPA[pc] := Point(xx + x1, yy + y1);
Inc(pc);
if (pc = maxToFind) then
goto theEnd;
end;
TheEnd: Free_CTSInfoArray(ctsinfoarray);Охх...читать такое - можно и мозг повредить.
Cynicrus,
01 Декабря 2014
+132
bool bitmap_to_24bit_string(bitmap *bmp, char **str, uint32_t *len)
{
if (!bmp || !bmp->pixels)
return false;
int I, J;
uint32_t size = ((bmp->width * 24 + 31) / 32) * 4 * bmp->height;
rgb24 *pixels = malloc(size);
if (pixels)
{
for (I = 0; I < bmp->height; ++I)
{
for (J = 0; J < bmp->width; ++J)
{
pixels[I * bmp->width + J].b = bmp->pixels[I * bmp->width + J].r;
pixels[I * bmp->width + J].g = bmp->pixels[I * bmp->width + J].g;
pixels[I * bmp->width + J].r = bmp->pixels[I * bmp->width + J].b;
}
}
uint32_t destlen = compressBound(size);
*str = malloc(destlen);
if (*str)
{
if (compress((Bytef *)*str, (uLongf *)&destlen, (Bytef *)pixels, size) == Z_OK)
{
free(pixels);
pixels = NULL;
char *b64str;
uint32_t b64_len;
if (base64encode((const uint8_t *)*str, destlen, &b64str, &b64_len))
{
free(*str);
*str = b64str;
*len = b64_len + 2;
b64str = malloc(*len);
if (b64str)
{
b64str[0] = 'm';
strncpy(&b64str[1], *str, b64_len);
free(*str);
*str = b64str;
(*str)[b64_len + 1] = '';
return true;
}
}
}
free(*str);
*len = 0;
*str = NULL;
}
free(pixels);
}
return false;
}Ещё подкину в общую копилку
Cynicrus,
01 Декабря 2014
+136
char *stringFromDTM(MDTM *dtm)
{
if (dtm->count < 1)
return "";
uint32_t size = (sizeof(MDTMPoint) + sizeof(uint32_t)) * dtm->count;
void *data = calloc(1, size);
uint32_t *ptr = data;
*(ptr++) = size;
uint32_t index;
for (index = 0; index < dtm->count; index++)
*(ptr++) = dtm->points[index].x;
for (index = 0; index < dtm->count; index++)
*(ptr++) = dtm->points[index].y;
for (index = 0; index < dtm->count; index++)
*(ptr++) = dtm->points[index].color;
for (index = 0; index < dtm->count; index++)
*(ptr++) = dtm->points[index].tol;
for (index = 0; index < dtm->count; index++)
*(ptr++) = dtm->points[index].size;
for (index = 0; index < dtm->count; index++)
*(ptr++) = dtm->points[index].x;
bool *bptr = (bool *)ptr;
for (index = 0; index < dtm->count; index++)
*(bptr++) = dtm->points[index].bad;
uint32_t len = compressBound(size);
char *buffer = malloc(len);
if (compress((Bytef *)buffer, (uLongf *)&len, data, size) == Z_OK)
{
free(data);
char *compressed = malloc(len + sizeof(uint32_t));
*((uint32_t *)(compressed)) = len;
strcpy(compressed + sizeof(uint32_t), buffer);
free(buffer);
}
free(buffer);
free(data);
return "";
}Я так и не раскурил, почему так, а не иначе.
Cynicrus,
01 Декабря 2014
+80
procedure TInventory.removeItem(userid: integer; invid: integer;amount: integer = 1);
var
MyRes: TInvItemArray;
CurrItem: TInvItem;
I,len: integer;
begin
if (amount <= 0) then
exit;
if (amount = 1) then
begin
db.removeItemFromUserInventory(GetItems(GetIndexByInvId(invid)),userid);
FInventoryList.Remove(GetIndexByInvId(invid));
end else
begin
if (amount >= finventorylist.Size) then
exit;
MyRes:=GetResources(invid);
len:=length(myres);
if (len = 0) then
exit;
if (amount > len) then
exit;
for i:=0 to len - 1 do
begin
curritem:=MyRes[i];
db.removeItemFromUserInventory(GetItems(GetIndexByInvId(curritem.InvId)),userid);
FInventoryList.Remove(GetIndexByInvId(curritem.invid));
end;
Setlength(myres,0);
end;
end;
function TInventory.GetResources(invid: integer): TInvItemArray;
function ToResult(var Return: TInvItemArray; const Item: TInvItem): Integer;
begin
Result := Length(Return);
SetLength(Return, Result + 1);
Return[Result] := Item;
end;
var
item,sameitem: TInvItem;
Resource: TItem;
i: integer;
begin
SetLength(result,0);
item:=GetItem(invid);
if (item = nil) then
exit;
if (item.item <> nil) then
begin
// if (item.itemю = 30) then
// begin
for i:=0 to FInventoryList.Size - 1 do
begin
sameitem:=TInvItem(FInventoryList.Items[i]);
if (sameitem = nil) then
continue;
resource:=sameitem.item;
if (resource = nil) then
continue;
if (item.item.itemid = resource.itemid) then
ToResult(result,sameitem);
end;
// end;
end;
end;По сути - удалить объект из списка. OMG!
Cynicrus,
29 Ноября 2014
+88
function TCalc.getRewardItems(items : AnsiString; countItems : integer; userId : Integer; from:integer) : ISuperObject;
var tmpFirstOdds : integer;
strLines, extrLines : TStringList;
strItems, strOdds, strOdds2: TIntegerList;
i, j, tmpCountItems : integer;
tmpOddsItems, sum : Integer;
str: ansistring;
begin
Result := nil;
// parse items line [id1,odd1],[id2,odd2],[id3,odd3]
strLines := TStringList.Create;
extrLines := TStringList.Create;
strItems := TIntegerList.Create;
strOdds := TIntegerList.Create;
ExtractStrings(['[', ']'],[','], PChar(items), strLines);
for i := 0 to strLines.Count - 1 do
begin
ExtractStrings([','],[' '], PChar(strLines[i]), extrLines);
strItems.Add(StrToInt(extrLines[0]));
strOdds.Add(StrToInt(extrLines[1]));
extrLines.Clear;
end;
// calculate odds [a,b,c,d] as [a,a+b,a+b+c,a+b+c+d]
sum := 0;
strOdds2 := TIntegerList.Create;
for i := 0 to strOdds.Count-1 do
begin
sum := sum + strOdds.Items[i];
strOdds2.Add(sum);
end;
// select items
str := '';
for i := 0 to countItems - 1 do
begin
tmpFirstOdds := Random(101); // 0-100
for j := 0 to strOdds2.Count-1 do
begin
if tmpFirstOdds < strOdds2.Items[j] then
begin
str := str + IntToStr(strItems[j]) + ',';
break;
end;
end;
end;
str := '['+Copy(str,1,Length(str)-1)+']';
// from monster
if from=0 then Result := so('{"part":"battle","func":"itemsdropped","data":'+str+'}');
// from chest
if from=1 then Result := so('{"part":"battle","func":"itemsdroppedchest","data":'+str+'}');
strLines.Free;
extrLines.Free;
strItems.Free;
strOdds.Free;
strOdds2.Free;
end;У меня чуть глаза не вытекли от такого решения. Код по идее сообщает клиенту, что выпало из монстра после победы над ним.
Cynicrus,
24 Ноября 2014
Follow us!