1 Star 0 Fork 3

hayden/Aibote4Pascal

forked from 黑魔/Aibote4Pascal 
加入 Gitee
与超过 1200万 开发者一起发现、参与优秀开源项目,私有仓库也完全免费 :)
免费加入
文件
克隆/下载
hmglobals.pas 9.01 KB
一键复制 编辑 原始数据 按行查看 历史
xiaoyu0417 提交于 2023-02-07 10:58 . 提交
unit hmGlobals;
{$mode Delphi} {$H+}
{$modeswitch functionreferences}{$modeswitch anonymousfunctions}
interface
uses
Classes, SysUtils, DateUtils, httpsend, blcksock, ssl_openssl, ssl_openssl_lib, synautil;
function IsNumberic(Vaule: string): boolean;
function MyPos(const Substr, s: string): integer;
function GetStringBetween(const Source, BegSprStr, EdSpStr: string): string;
function ArrayToString(arr: TStrings; split: string = ','): string;
function SplitString(const Source, Deli: string): TArray<string>;
function RoundFloat(f: double; I: integer): double;
function GetRandStr(len: integer; LowerCase: boolean = True; num: boolean = True; UpperCase: boolean = False): string;
function GetJavaTime(d: TDateTime): int64;
function GetRandMacStr: string;
function HttpGet(const url: string; encoding: string = 'UTF-8'; cookie: TStringList = nil): string;
function HttpPost(const URL, Data: string; encoding: string = 'UTF-8'; mtype: string = 'application/x-www-form-urlencoded'; cookie: TStringList = nil): string;
implementation
function IsNumberic(Vaule: string): boolean; // 判断Vaule是不是数字
var
I: integer;
begin
Result := True; // 设置返回值为是(真)
Vaule := Trim(Vaule); // 去空格
if Vaule.IsEmpty then
begin
Result := False;
exit;
end;
for I := 1 to Length(Vaule) do // 准备循环
begin
if not (Vaule[I] in ['0' .. '9']) then // 如果Vaule的第i个字不是0-9中的任一个
begin
Result := False; // 返回值 不是(假)
exit; // 退出函数
end;
end;
end;
function MyPos(const Substr, s: string): integer;
begin
Result := Pos(LowerCase(Substr), LowerCase(s));
end;
function GetStringBetween(const Source, BegSprStr, EdSpStr: string): string;
var
BegStr1Len, EdSpStr2Len, BegStr1Index, EdSpStr2index: integer;
Temp: string;
begin
Temp := Source;
BegStr1Index := MyPos(BegSprStr, Temp);
if BegStr1Index <= 0 then
begin
Result := '';
exit;
end;
BegStr1Len := Length(BegSprStr);
Delete(Temp, 1, BegStr1Index + BegStr1Len - 1);
EdSpStr2index := MyPos(EdSpStr, Temp);
if EdSpStr2index <= 0 then
begin
Result := '';
exit;
end;
EdSpStr2Len := Length(EdSpStr);
Result := Trim(Copy(Temp, 1, EdSpStr2index - 1));
end;
function ArrayToString(arr: TStrings; split: string = ','): string;
var
i: integer;
begin
Result := '';
for I := 0 to arr.Count - 1 do
begin
Result := Result + arr[I];
if I <> arr.Count - 1 then
begin
Result := Result + split;
end;
end;
end;
function SplitString(const Source, Deli: string): TArray<string>;
var
str: TArray<string>;
j: integer;
EndOfCurrentString: integer;
s: string;
begin
j := 0;
SetLength(str, 5000);
s := Source;
while MyPos(Deli, s) > 0 do
begin
EndOfCurrentString := MyPos(Deli, s);
str[j] := Copy(s, 1, EndOfCurrentString - 1);
s := Copy(s, EndOfCurrentString + Length(Deli), Length(s) - EndOfCurrentString);
j := j + 1;
Sleep(0);
end;
if Length(Trim(s)) > 0 then
begin
str[j] := s;
j := j + 1;
end;
SetLength(str, j);
Result := str;
end;
function RoundFloat(f: double; I: integer): double;
var
s: string;
ef: extended;
begin
if f = 0 then
begin
Result := 0;
exit;
end;
s := '#.' + StringOfChar('0', I);
if s = '#.' then
s := '#';
ef := StrToFloat(FloatToStr(f)); // 防止浮点运算的误差
Result := StrToFloat(FormatFloat(s, ef));
end;
function GetRandStr(len: integer; LowerCase: boolean = True; num: boolean = True; UpperCase: boolean = False): string;
const
upperStr = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ';
lowerStr = 'abcdefghijklmnopqrstuvwxyz';
numStr = '0123456789';
var
sourceStr: string;
I: integer;
begin
sourceStr := '';
Result := '';
if UpperCase = True then
sourceStr := sourceStr + upperStr;
if LowerCase = True then
sourceStr := sourceStr + lowerStr;
if num = True then
sourceStr := sourceStr + numStr;
if (sourceStr = '') or (len < 1) then
exit;
Randomize;
for I := 1 to len do
begin
Result := Result + sourceStr[Random(Length(sourceStr) - 1) + 1];
end;
end;
function StreamToStr(const head: string; const Stream: TStream): string;
var
StringBytes: TBytes;
charset: string;
begin
charset := 'utf-8';
if Pos('charset=', head) > 0 then
begin
charset := Trim(GetStringBetween(head, 'charset=', #13));
if charset = '' then
begin
charset := Trim(GetStringBetween(head, 'charset=', ' '));
end;
if charset = '' then
begin
charset := Trim(GetStringBetween(head, 'charset=', ';'));
end;
if charset = '' then
begin
charset := Trim(GetStringBetween(head, 'charset=', #10));
end;
end;
if charset = '' then
begin
charset := 'utf-8';
end;
charset := LowerCase(charset);
if charset = 'gbk' then
charset := 'gb2312';
Stream.Position := 0;
SetLength(StringBytes, Stream.Size);
Stream.ReadBuffer(StringBytes, Stream.Size);
try
Result := utf8encode(TEncoding.GetEncoding(utf8decode(charset)).GetString(StringBytes));
except
try
Result := utf8encode(TEncoding.GetEncoding('gb2312').GetString(StringBytes));
except
end;
end;
end;
function GetJavaTime(d: TDateTime): int64;
var
dJavaStart: TDateTime;
begin
// java里的时间是从1970年1月1日0点到当前的间隔
dJavaStart := EncodeDateTime(1970, 1, 1, 8, 0, 0, 0);
Result := MilliSecondsBetween(d, dJavaStart);
end;
function GetRandMacStr: string;
const
numStr = '0123456789ABCDEF';
var
I: integer;
begin
Result := '';
Randomize;
for I := 1 to 2 do
begin
Result := Result + numStr[Random(Length(numStr) - 1) + 1];
end;
end;
function HttpPost(const URL, Data: string; encoding: string = 'UTF-8'; mtype: string = 'application/x-www-form-urlencoded'; cookie: TStringList = nil): string;
var
HTTP: THTTPSend;
ret: boolean;
fResultStream: TStringStream;
i: integer;
realurl, ck: string;
begin
HTTP := THTTPSend.Create;
try
fResultStream := tstringstream.Create('', tencoding.GetEncoding(utf8decode(encoding)));
WriteStrToStream(HTTP.Document, Data);
HTTP.MimeType := mtype;
http.Sock.CreateWithSSL(TSSLOpenSSL);
http.Sock.SSLDoConnect;
if cookie <> nil then
begin
http.Cookies.AddStrings(cookie);
end;
//http.Sock.SSL.SSLType:= LT_TLSv1_2;
http.UserAgent := 'Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/108.0.0.0 Safari/537.36 Edg/108.0.1462.54';
ret := HTTP.HTTPMethod('POST', URL);
if ret then
begin
// If its a 301 or 302 we need to do more processing
if (HTTP.ResultCode = 301) or (HTTP.ResultCode = 302) then
begin
// Check the headers for the Location header
for i := 0 to HTTP.Headers.Count - 1 do
begin
// Extract the URL
if Copy(HTTP.Headers[i], 1, 8).Equals('Location', True) then
realurl := Copy(HTTP.Headers[i], 11, Length(HTTP.Headers[i]) - 11);
end;
// If we have a URL, run it through the same function
if Length(realurl) > 1 then
begin
//ck := http.Cookies.Text;
Result := HTTPGet(realurl, encoding, http.Cookies);
end;
end
else
begin
http.Document.Position := 0;
fResultStream.LoadFromStream(http.Document);
Result := fResultStream.DataString;
end;
end;
finally
fResultStream.Free;
HTTP.Free;
end;
end;
function HttpGet(const url: string; encoding: string = 'UTF-8'; cookie: TStringList = nil): string;
var
http: thttpsend;
fResultStream: TStringStream;
i: integer;
realurl, ck: string;
begin
try
fResultStream := tstringstream.Create('', tencoding.GetEncoding(utf8decode(encoding)));
http := thttpsend.Create;
http.Sock.CreateWithSSL(TSSLOpenSSL);
http.Sock.SSLDoConnect;
if cookie <> nil then
begin
http.Cookies.AddStrings(cookie);
end;
//http.Sock.SSL.SSLType:= LT_TLSv1_2;
http.UserAgent := 'Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/108.0.0.0 Safari/537.36 Edg/108.0.1462.54';
if http.HTTPMethod('GET', url) then
begin
// If its a 301 or 302 we need to do more processing
if (HTTP.ResultCode = 301) or (HTTP.ResultCode = 302) then
begin
// Check the headers for the Location header
for i := 0 to HTTP.Headers.Count - 1 do
begin
// Extract the URL
if Copy(HTTP.Headers[i], 1, 8).Equals('Location', True) then
realurl := Copy(HTTP.Headers[i], 11, Length(HTTP.Headers[i]) - 11);
end;
// If we have a URL, run it through the same function
if Length(realurl) > 1 then
begin
//ck := http.Cookies.Text;
Result := HTTPGet(realurl, encoding, http.Cookies);
end;
end
else
begin
http.Document.Position := 0;
fResultStream.LoadFromStream(http.Document);
Result := fResultStream.DataString;
end;
end;
finally
FreeAndNil(http);
FreeAndNil(fResultStream);
end;
end;
end.
Loading...
马建仓 AI 助手
尝试更多
代码解读
代码找茬
代码优化
Pascal
1
https://gitee.com/haydenlong/aibote4-pascal.git
[email protected]:haydenlong/aibote4-pascal.git
haydenlong
aibote4-pascal
Aibote4Pascal
master

搜索帮助