StrSub.pas

unit StrSub;

interface

uses
  SysUtils, StrUtils, WinTypes, Classes, Forms, WinSock, Jpeg;

function SkipSpace(Str: string): string;
function Copy2(Str: string; Index: integer; Count: integer = -1): string;
function SeparateLf(var Str: string): string;
function SeparateCrLf(var Str: string): string;
function SeparateCrLf2(var Str: string): string;
function SeparateBracket(var Str: string): string;
function SeparateWord(Word: string; var Str: string): string;
function StrToInt2(Str: string; Default: integer = 0): integer;
function IntToStr2(Number: integer): string;
function ConvToHtml(Str: string): string;
function ConvTimeT(DateTime: TDateTime): longint;
function ConvTimeStr(time_t: string): TDateTime;
function JapaneseTime(DateTime: TDateTime): string;
function SeparateNodeHost(Node: string): string;
function SeparateNodePort(Node: string): string;
function SeparateNodePath(Node: string): string;
procedure Log(Text: string; Level: integer = 1; FileName: string = '');
function UrlDecode(const EncodedStr: String): String;
function URLEncode(const str: string): string;
procedure SeparateStampId(Str: string; var Stamp: string; var Id: string);
function CountStr(Word: string; Str: string): integer;
function CopyChar(const Buffer: array of char; Index: integer; Count: integer): string;
function Base64EncodeStr(Str: string): string;
function Base64DecodeStr(Data: string): string;
procedure GetImageSize(f: TMemoryStream; Ext: string; var Width: integer; var Height: integer);
function CompareText2(Str1: string; Str2: string): integer;
function MD5String(S: string): string;
function ReverseFromHtml(Str: string): string;

implementation

uses
  Base64, MD5, jconvert,
  Config;

function Copy2(Str: string; Index: integer; Count: integer = -1): string;
var
  n: integer;
begin
  n := Length(Str);
  if n > Index - 1 then begin
    if Count = -1 then begin
      Count := n - (Index - 1);
    end;
    result := Copy(Str, Index, Count);
  end else begin
    result := '';
  end;
end;

function SeparateBracket(var Str: string): string;
begin
  result := SeparateWord('<>', Str);
end;

function SeparateLf(var Str: string): string;
begin
  result := SeparateWord(#$0a, Str);
end;

function SeparateCrLf(var Str: string): string;
begin
  result := SeparateWord(#$0d + #$0a, Str);
end;

function SeparateCrLf2(var Str: string): string;
begin
  result := SeparateWord(#$0d + #$0a + #$0d + #$0a, Str);
end;

function SeparateWord(Word: string; var Str: string): string;
var
  n: integer;
  nn: integer;
begin
  n := Pos(word, Str);
  if n <= 0 then begin
    result := Str;
    Str := '';
  end else begin
    nn := Length(word);
    result := Copy(Str, 1, n - 1);
    Str := Copy2(Str, n + nn);
  end;
end;

function SkipSpace(Str: string): string;
var
  n: integer;
  i: integer;
  k: integer;
  c: char;
begin
  n := Length(Str);
  k := 1;
  for i := 1 to n do begin
    c := Str[i];
    if not ((c = ' ') or (c = #$0d) or (c = #$0a)) then begin
      k := i;
      break;
    end;
  end;
  Str := Copy(Str, k, n - k + 1);
  n := Length(Str);
  k := n;
  for i := n downto 1 do begin
    c := Str[i];
    if not ((c = ' ') or (c = #$0d) or (c = #$0a)) then begin
      k := i;
      break;
    end;
  end;
  result := Copy(Str, 1, k);
end;

function IsNumber(Str: string): boolean;
var
  n: integer;
  i: integer;
  c: char;
begin
  result := false;
  Str := SkipSpace(Str);
  n := Length(Str);
  if n <= 0 then begin
    exit;
  end;
  for i := 1 to n do begin
    c := Str[i];
    if not (
      (('0' <= c) and (c <= '9'))
    ) then begin
      exit;
    end;
  end;
  result := true;
end;

function StrToInt2(Str: string; Default: integer = 0): integer;
begin
  result := Default;
  if IsNumber(Str) then begin
    try
      result := StrToInt(Str);
    except
      result := Default;
    end;
  end;
end;

function IntToStr2(Number: integer): string;
begin
  result := IntToStr(Number);
  result := Copy('0000000000', 1, 10 - Length(result)) + result;
end;

function ConvToHtml(Str: string): string;
var
  i: integer;
  n: integer;
begin
  result := '';
  n := Length(Str);
  for i := 1 to n do begin
    if Str[i] = #$0a then begin
      result := result + '<br>';
    end else if Str[i] = #$0d then begin
      //
    end else if Str[i] = '&' then begin
      result := result + '&amp;';
    end else if Str[i] = '<' then begin
      result := result + '&lt;';
    end else if Str[i] = '>' then begin
      result := result + '&gt;';
    end else begin
      result := result + Str[i];
    end;
  end;
end;

function ReverseFromHtml(Str: string): string;
begin
  Str := euc2sjis(Str);
  Str := AnsiReplaceStr(Str, '<br>', #$0a);
  Str := AnsiReplaceStr(Str, '&lt;', '<');
  Str := AnsiReplaceStr(Str, '&gt;', '>');
  Str := AnsiReplaceStr(Str, '&amp;', '&');
  result := sjis2euc(Str);
end;

function ConvTimeT(DateTime: TDateTime): longint;
var
  TimeZoneInformation: TTimeZoneInformation;
  Bias: TDateTime;
begin
  GetTimeZoneInformation(TimeZoneInformation);
  Bias := (365 * 70 + 19) - TimeZoneInformation.Bias / (60 * 24);
  result := Trunc((DateTime - Bias) * (24 * 60 * 60));
end;

function ConvTime(time_t: longint): TDateTime;
var
  TimeZoneInformation: TTimeZoneInformation;
  Bias: TDateTime;
begin
  GetTimeZoneInformation(TimeZoneInformation);
  Bias := (365 * 70 + 19) - TimeZoneInformation.Bias / (60 * 24);
  result := time_t / (24 * 60 * 60) + Bias;
end;

function ConvTimeStr(time_t: string): TDateTime;
begin
  result := ConvTime(StrToInt2(time_t));
end;

function EnglishTime(DateTime: TDateTime): string;
var
  w: integer;
  YEAR: Word;
  MONTH: Word;
  DAY: Word;
begin
  result := '';
  w := DayOfWeek(DateTime);
  case w of
  1: result := result + 'Sun';
  2: result := result + 'Mon';
  3: result := result + 'Tue';
  4: result := result + 'Wed';
  5: result := result + 'Thu';
  6: result := result + 'Fri';
  else
    result := result + 'Sat';
  end;
  result := result + ' ';
  DecodeDate(DateTime, YEAR, MONTH, DAY);
  w := MONTH;
  case w of
  1: result := result + 'Jan';
  2: result := result + 'Feb';
  3: result := result + 'Mar';
  4: result := result + 'Apr';
  5: result := result + 'May';
  6: result := result + 'Jun';
  7: result := result + 'Jul';
  8: result := result + 'Aug';
  9: result := result + 'Sep';
  10: result := result + 'Oct';
  11: result := result + 'Nov';
  else
    result := result + 'Dec';
  end;
  result := result + ' ';
  result := result + FormatDateTime('d hh:mm:ss yyyy', DateTime);
end;

function JapaneseTime(DateTime: TDateTime): string;
begin
  result := FormatDateTime('yyyy/mm/dd hh:mm', DateTime);
end;

function SeparateNodeHost(Node: string): string;
begin
  result := SeparateWord(':', Node);
end;

function SeparateNodePort(Node: string): string;
begin
  SeparateWord(':', Node);
  result := SeparateWord('/', Node);
end;

function SeparateNodePath(Node: string): string;
begin
  SeparateWord('/', Node);
  result := Node;
end;

procedure Log(Text: string; Level: integer = 1; FileName: string = '');
var
  FileStream: TFileStream;
  ok: boolean;
begin
  if not (FConfig.FDebugLog >= Level) then begin
    exit;
  end;
  if FileName = '' then begin
    FileName := 'log';
  end;
  FileName := ExtractFilePath(Application.ExeName) + '\dat\' + FileName + '.txt';
  ok := false;
  while true do begin
    try
      if FileExists(FileName) then begin
        FileStream := TFileStream.Create(FileName, fmOpenReadWrite or fmShareDenyWrite);
      end else begin
        FileStream := TFileStream.Create(FileName, fmCreate or fmOpenReadWrite or fmShareDenyWrite);
      end;
      try
        FileStream.Seek(0, soFromEnd);
        FileStream.WriteBuffer(pchar(Text)^, Length(Text));
      finally
        FileStream.Free;
        ok := true;
      end;
    except
    end;
    if ok then begin
      exit;
    end;
    sleep(100);
  end;
end;

function HexToInt(HexStr: String): Int64;
var RetVar : Int64;
    i : byte;
begin
  HexStr := UpperCase(HexStr);
  if HexStr[length(HexStr)] = 'H' then
     Delete(HexStr,length(HexStr),1);
  RetVar := 0;

  for i := 1 to length(HexStr) do begin
      RetVar := RetVar shl 4;
      if HexStr[i] in ['0'..'9'] then
         RetVar := RetVar + (byte(HexStr[i]) - 48)
      else
         if HexStr[i] in ['A'..'F'] then
            RetVar := RetVar + (byte(HexStr[i]) - 55)
         else begin
            Retvar := 0;
            break;
         end;
  end;

  Result := RetVar;
end;

function UrlDecode(const EncodedStr: String): String;
var
  I: Integer;
begin
  Result := '';
  if Length(EncodedStr) > 0 then
  begin
    I := 1;
    while I <= Length(EncodedStr) do
    begin
      if EncodedStr[I] = '%' then
        begin
          Result := Result + Chr(HexToInt(EncodedStr[I+1]
                                       + EncodedStr[I+2]));
          I := Succ(Succ(I));
        end
      else if EncodedStr[I] = '+' then
        Result := Result + ' '
      else
        Result := Result + EncodedStr[I];

      I := Succ(I);
    end;
  end;
end;

function URLEncode(const str: string): string;
var
  s: string;
  i: integer;
begin
  s := '';
  for i := 1 to length(str) do
  begin
    case str[i] of
    '0'..'9','A'..'Z','a'..'z','_','.':
      s := s + str[i];
    else
      s := s + Format('%%%2.2X', [Ord(str[i])]);
    end;
  end;
  result := s;
end;

procedure SeparateStampId(Str: string; var Stamp: string; var Id: string);
begin
  Stamp := SeparateBracket(Str);
  Id := SeparateBracket(Str);
end;

function CountStr(Word: string; Str: string): integer;
var
  k: integer;
  n: integer;
begin
  result := 0;
  n := Length(Word);
  while true do begin
    k := Pos(Word, Str);
    if k <= 0 then begin
      break;
    end;
    Str := Copy2(Str, k + n);
    Inc(result);
  end;
end;

function CopyChar(const Buffer: array of char; Index: integer; Count: integer): string;
begin
  SetLength(result, Count);
  Move(Buffer[Index], result[1], Count);
end;

function MD5String(S: string): string;
var
  ctx: MD5Context;
  digest: array[0..15]of char;
  I: integer;
begin
  MD5Init(ctx);
  MD5Update(ctx, PBYTE(PChar(S)), Length(S));
  MD5Final(ctx, digest);
  result := '';
  for i := 0 to 15 do begin
    result := Result + LowerCase(IntToHex(BYTE(digest[i]), 2));
  end;
end;

function Base64EncodeStr(Str: string): string;
var
  mStream: TMemoryStream;
begin
  mStream := TMemoryStream.Create;
  mStream.Position := 0;
  mStream.Write(pchar(Str)^, Length(Str));
  mStream.Position := 0;
  result := base64encode(mStream, mStream.Size);
  mStream.Free;
end;

function Base64DecodeStr(Data: string): string;
const
  MassBufferSize  = $1000;
type
  TMassBuffer = array[0..0] of char;
var
  stream: TMemoryStream;
  MassBuffer: ^TMassBuffer;
  n: integer;
begin
  stream := TMemoryStream.Create;
  stream.Position := 0;
  base64decode(stream, Data);
  GetMem(MassBuffer, MassBufferSize);
  stream.Position := 0;
  result := '';
  n := stream.Read(MassBuffer^, MassBufferSize);
  while n > 0 do begin
    result := result + CopyChar(MassBuffer^, 0, n);
    n := stream.Read(MassBuffer^, MassBufferSize);
  end;
  FreeMem(MassBuffer);
  stream.Free;
end;

procedure GetImageSize(f: TMemoryStream; Ext: string; var Width: integer; var Height: integer);
var
  jpeg: TJpegImage;
  gif: array[0..5] of char;
  w: array[0..3] of byte;
  h: array[0..3] of byte;
begin
  Height := -1;
  Width := -1;
  try
    ext := UpperCase(Ext);
    if (ext = '.JPG') or (ext = '.JPEG') or (ext = '.JPE')  then begin
      jpeg := TJpegImage.Create;
      try
        jpeg.LoadFromStream(f);
        Width := jpeg.Width;
        Height := jpeg.Height;
      finally
        jpeg.Free;
      end;
    end else if ext = '.GIF' then begin
      if f.Size >= 10 then begin
        f.Read(gif, 6);
        if (gif = 'GIF87a') or (gif = 'GIF89a') then begin
          f.Read(w, 2);
          f.Read(h, 2);
          Width  := w[1] * 256 + w[0];
          Height := h[1] * 256 + h[0];
        end;
      end;
    end else if ext = '.PNG' then begin
      if f.Size >= 24 then begin
        f.Seek(16, soFromBeginning);
        f.Read(w, 4);
        f.Read(h, 4);
        Width  := ((w[0] * 256 + w[1]) * 256 + w[2]) * 256 + w[3];
        Height := ((h[0] * 256 + h[1]) * 256 + h[2]) * 256 + h[3];
      end;
    end;
  except
  end;
end;

function CompareText2(Str1: string; Str2: string): integer;
begin
  result := CompareText(Copy(Str1, 1, Length(Str2)), Str2);
end;

end.