unit Ufunction;

interface
uses windows, classes, sysutils, activex, comobj, shlobj, Controls, StdCtrls, Graphics,
  ExtCtrls, Buttons, Dialogs;

function GetTempDir: string;
function getvalue_back(s1,s_w,e_w:string):string;
function speialcharhtml(s:string):string;
function getvalue(s1,s_w,e_w:string):string;
function Get_File_Size2(sFileToExamine: string): integer;
function ConvertSize(value:int64):string;
function GetSpecialFolder(nfolder:integer): string;
function _messagedlg(owner:tcontrol;text:string;dlgtype:TMsgDlgType;selbutton:TMsgDlgBtn=mbOK):integer;

implementation
uses Consts, math, CommDlg, forms;

function GetTempDir: string;
var
  Buffer: array[0..MAX_PATH] of Char;
begin
  GetTempPath(SizeOf(Buffer) - 1, Buffer);
  Result := StrPas(Buffer);
  if (Result<>'') and (Result[length(Result)]<>'\') then
    Result:=Result+'\';
end;

function getvalue_back(s1,s_w,e_w:string):string;
var
  p1,p2,p3:integer;
  s2:string;
begin
  s2:='';
  p1:=pos(s_w,s1);
  while p1>0 do begin
    s2:=copy(s1,p1+length(s_w),length(s1));
    delete(s1,1,p1+length(s_w));
    p1:=pos(s_w,s1);
  end;
  if s2<>'' then begin
    p3:=pos(e_w,s2);
    if p3>0 then begin
      result:=copy(s2,1,p3-1);
    end;
  end;
end;

function speialcharhtml(s:string):string;
const
  special: array[0..10,0..1] of string =
   (('&','&amp;'), ('<','&lt;'), ('>','&gt;'), ('"','&quot;'), (#39,'&#39;'),
    ('%','&#37;'),
    ('(','&#40;'), (')','&#41;'), ('+','&#43;'), ('-','&#45;'),
    ('''','&#039;')
   );
var
  i:integer;
begin
  for i:=0 to high(special) do begin
    s:=sysutils.StringReplace(s,special[i][1],special[i][0],[rfIgnoreCase,rfReplaceAll]);
  end;
  result:=s;
end;

function getvalue(s1,s_w,e_w:string):string;
var s2:string;
  p1:integer;
begin
  result:='';
  p1:=pos(s_w,lowercase(s1));
  if p1=0 then
     exit;
  s2:=copy(s1,p1+length(s_w),length(s1));
  p1:=pos(e_w,lowercase(s2));
  result:=copy(s2,1,p1-1);
end;

function Get_File_Size2(sFileToExamine: string): integer;
var
  SearchRec: TSearchRec;
  inRetval, I1: Integer;
begin
  try
    inRetval := FindFirst(sFileToExamine, faAnyFile, SearchRec);
    if inRetval = 0 then
      I1 := SearchRec.Size
    else
      I1 := -1;
  finally
    SysUtils.FindClose(SearchRec);
  end;
  Result := I1;
end;

function ConvertSize(value:int64):string;
var
  d:double;
begin
try
  if value > (1024*1024) then begin
     d := (value / (1024*1024));
     result:=formatfloat('##.#', d) + ' M';
  end else if value > 1024 then begin
     d := (value / 1024);
     result:=formatfloat('##.#', d) + ' Kb';
  end else begin
     result:=floattostr(value) + ' b';
  end;
except
  result:= '0 b';
end;
end;

function GetSpecialFolder(nfolder:integer): string;
var
  shellMalloc: IMalloc;
  ppidl: PItemIdList;
  PerDir: string;
begin
  ppidl := nil;
  try
    if SHGetMalloc(shellMalloc) = NOERROR then begin
      SHGetSpecialFolderLocation(0, nfolder, ppidl);
      SetLength(Result, MAX_PATH);
      if not SHGetPathFromIDList(ppidl, PChar(Result)) then
        raise exception.create('SHGetPathFromIDList failed : invalid pidl');
      SetLength(Result, lStrLen(PChar(Result)));
      if Result<>'' then
        if Result[length(Result)]<>'\' then Result:=Result+'\';
    end;
  finally
    if ppidl <> nil then
      shellMalloc.free(ppidl);
  end;
end;

var
  ModalResults: array[TMsgDlgBtn] of Integer = (
    mrYes, mrNo, mrOk, mrCancel, mrAbort, mrRetry, mrIgnore, mrAll, mrNoToAll,
    mrYesToAll, 0);
  ButtonNames: array[TMsgDlgBtn] of string = (
    'Yes', 'No', 'OK', 'Cancel', 'Abort', 'Retry', 'Ignore', 'All', 'NoToAll',
    'YesToAll', 'Help');
  Captions: array[TMsgDlgType] of string = (SMsgDlgWarning, SMsgDlgError,
    SMsgDlgInformation, SMsgDlgConfirm, '');
  IconIDs: array[TMsgDlgType] of PChar = (IDI_EXCLAMATION, IDI_HAND,
    IDI_ASTERISK, IDI_QUESTION, nil);
  ButtonWidths : array[TMsgDlgBtn] of integer;  // initialized to zero
  ButtonCaptions: array[TMsgDlgBtn] of string = (
    SMsgDlgYes, SMsgDlgNo, SMsgDlgOK, SMsgDlgCancel, SMsgDlgAbort,
    SMsgDlgRetry, SMsgDlgIgnore, SMsgDlgAll, SMsgDlgNoToAll, SMsgDlgYesToAll,
    SMsgDlgHelp);

type
  TMessageForm = class(TForm)
  private
    Message: TLabel;
    parenthandle:thandle;

    procedure HelpButtonClick(Sender: TObject);
  protected
    procedure CustomKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure WriteToClipBoard(Text: String);
    function GetFormText: String;
    procedure CreateParams(var Params: TCreateParams); override;
  public
//    constructor Create(AOwner:TComponent;parenthandle:thandle); reintroduce;
    constructor CreateNew(AOwner: TComponent;phandle:thandle); reintroduce;
  end;

 {
constructor TMessageForm.Create(AOwner:TComponent;parenthandle:thandle);
begin
  self.parenthandle:=parenthandle;
  inherited Create(AOwner);
end;
}
procedure TMessageForm.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  with Params do begin
    WndParent := parenthandle;
  end;
end;

constructor TMessageForm.CreateNew(AOwner: TComponent;phandle:thandle);
var
  NonClientMetrics: TNonClientMetrics;
begin
  parenthandle:=phandle;
  inherited CreateNew(AOwner);
  NonClientMetrics.cbSize := sizeof(NonClientMetrics);
  if SystemParametersInfo(SPI_GETNONCLIENTMETRICS, 0, @NonClientMetrics, 0) then
    Font.Handle := CreateFontIndirect(NonClientMetrics.lfMessageFont);
end;

procedure TMessageForm.HelpButtonClick(Sender: TObject);
begin
  Application.HelpContext(HelpContext);
end;

procedure TMessageForm.CustomKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
  if (Shift = [ssCtrl]) and (Key = Word('C')) then
  begin
    Beep;
    WriteToClipBoard(GetFormText);
  end;
end;

procedure TMessageForm.WriteToClipBoard(Text: String);
var
  Data: THandle;
  DataPtr: Pointer;
begin
  if OpenClipBoard(0) then
  begin
    try
      Data := GlobalAlloc(GMEM_MOVEABLE+GMEM_DDESHARE, Length(Text) + 1);
      try
        DataPtr := GlobalLock(Data);
        try
          Move(PChar(Text)^, DataPtr^, Length(Text) + 1);
          EmptyClipBoard;
          SetClipboardData(CF_TEXT, Data);
        finally
          GlobalUnlock(Data);
        end;
      except
        GlobalFree(Data);
        raise;
      end;
    finally
      CloseClipBoard;
    end;
  end
  else
    raise Exception.CreateRes(@SCannotOpenClipboard);
end;

function TMessageForm.GetFormText: String;
var
  DividerLine, ButtonCaptions: string;
  I: integer;
begin
  DividerLine := StringOfChar('-', 27) + sLineBreak;
  for I := 0 to ComponentCount - 1 do
    if Components[I] is TButton then
      ButtonCaptions := ButtonCaptions + TButton(Components[I]).Caption +
        StringOfChar(' ', 3);
  ButtonCaptions := StringReplace(ButtonCaptions,'&','', [rfReplaceAll]);
  Result := Format('%s%s%s%s%s%s%s%s%s%s', [DividerLine, Caption, sLineBreak,
    DividerLine, Message.Caption, sLineBreak, DividerLine, ButtonCaptions,
    sLineBreak, DividerLine]);
end;

function GetAveCharSize(Canvas: TCanvas): TPoint;
var
  I: Integer;
  Buffer: array[0..51] of Char;
begin
  for I := 0 to 25 do Buffer[I] := Chr(I + Ord('A'));
  for I := 0 to 25 do Buffer[I + 26] := Chr(I + Ord('a'));
  GetTextExtentPoint(Canvas.Handle, Buffer, 52, TSize(Result));
  Result.X := Result.X div 52;
end;

function CreateMessageDialog(owner:tform; const Msg: string; DlgType: TMsgDlgType;
  Buttons: TMsgDlgButtons; SelButton:TMsgDlgBtn): TForm;
const
  mcHorzMargin = 8;
  mcVertMargin = 8;
  mcHorzSpacing = 10;
  mcVertSpacing = 10;
  mcButtonWidth = 50;
  mcButtonHeight = 14;
  mcButtonSpacing = 4;
var
  DialogUnits: TPoint;
  HorzMargin, VertMargin, HorzSpacing, VertSpacing, ButtonWidth,
  ButtonHeight, ButtonSpacing, ButtonCount, ButtonGroupWidth,
  IconTextWidth, IconTextHeight, X, ALeft: Integer;
  B, DefaultButton, CancelButton: TMsgDlgBtn;
  IconID: PChar;
  TextRect: TRect;
begin
  Result := TMessageForm.CreateNew(owner,owner.Handle);
  with Result do
  begin
    BiDiMode := Application.BiDiMode;
    BorderStyle := bsDialog;
    Canvas.Font := Font;
    KeyPreview := True;
    OnKeyDown := TMessageForm(Result).CustomKeyDown;
    DialogUnits := GetAveCharSize(Canvas);
    HorzMargin := MulDiv(mcHorzMargin, DialogUnits.X, 4);
    VertMargin := MulDiv(mcVertMargin, DialogUnits.Y, 8);
    HorzSpacing := MulDiv(mcHorzSpacing, DialogUnits.X, 4);
    VertSpacing := MulDiv(mcVertSpacing, DialogUnits.Y, 8);
    ButtonWidth := MulDiv(mcButtonWidth, DialogUnits.X, 4);
    for B := Low(TMsgDlgBtn) to High(TMsgDlgBtn) do
    begin
      if B in Buttons then
      begin
        if ButtonWidths[B] = 0 then
        begin
          TextRect := Rect(0,0,0,0);
          Windows.DrawText( canvas.handle,
            PChar(ButtonCaptions[B]), -1,
            TextRect, DT_CALCRECT or DT_LEFT or DT_SINGLELINE or
            DrawTextBiDiModeFlagsReadingOnly);
          with TextRect do ButtonWidths[B] := Right - Left + 8;
        end;
        if ButtonWidths[B] > ButtonWidth then
          ButtonWidth := ButtonWidths[B];
      end;
    end;
    ButtonHeight := MulDiv(mcButtonHeight, DialogUnits.Y, 8);
    ButtonSpacing := MulDiv(mcButtonSpacing, DialogUnits.X, 4);
    SetRect(TextRect, 0, 0, Screen.Width div 2, 0);
    DrawText(Canvas.Handle, PChar(Msg), Length(Msg)+1, TextRect,
      DT_EXPANDTABS or DT_CALCRECT or DT_WORDBREAK or
      DrawTextBiDiModeFlagsReadingOnly);
    IconID := IconIDs[DlgType];
    IconTextWidth := TextRect.Right;
    IconTextHeight := TextRect.Bottom;
    if IconID <> nil then
    begin
      Inc(IconTextWidth, 32 + HorzSpacing);
      if IconTextHeight < 32 then IconTextHeight := 32;
    end;
    ButtonCount := 0;
    for B := Low(TMsgDlgBtn) to High(TMsgDlgBtn) do
      if B in Buttons then Inc(ButtonCount);
    ButtonGroupWidth := 0;
    if ButtonCount <> 0 then
      ButtonGroupWidth := ButtonWidth * ButtonCount +
        ButtonSpacing * (ButtonCount - 1);
    ClientWidth := Max(IconTextWidth, ButtonGroupWidth) + HorzMargin * 2;
    ClientHeight := IconTextHeight + ButtonHeight + VertSpacing +
      VertMargin * 2;
    Left := (Screen.Width div 2) - (Width div 2);
    Top := (Screen.Height div 2) - (Height div 2);
    if DlgType <> mtCustom then
      Caption := Captions[DlgType] else
      Caption := Application.Title;
    if IconID <> nil then
      with TImage.Create(Result) do
      begin
        Name := 'Image';
        Parent := Result;
        Picture.Icon.Handle := LoadIcon(0, IconID);
        SetBounds(HorzMargin, VertMargin, 32, 32);
      end;
    TMessageForm(Result).Message := TLabel.Create(Result);
    with TMessageForm(Result).Message do
    begin
      Name := 'Message';
      Parent := Result;
      WordWrap := True;
      Caption := Msg;
      BoundsRect := TextRect;
      BiDiMode := Result.BiDiMode;
      ALeft := IconTextWidth - TextRect.Right + HorzMargin;
      if UseRightToLeftAlignment then
        ALeft := Result.ClientWidth - ALeft - Width;
      SetBounds(ALeft, VertMargin,
        TextRect.Right, TextRect.Bottom);
    end;
    DefaultButton:=SelButton;
{    if mbOk in Buttons then DefaultButton := mbOk else
      if mbYes in Buttons then DefaultButton := mbYes else
        DefaultButton := mbRetry;}
    if mbCancel in Buttons then CancelButton := mbCancel else
      if mbNo in Buttons then CancelButton := mbNo else
        CancelButton := mbOk;
    X := (ClientWidth - ButtonGroupWidth) div 2;
    for B := Low(TMsgDlgBtn) to High(TMsgDlgBtn) do
      if B in Buttons then
        with TButton.Create(Result) do
        begin
          Name := ButtonNames[B];
          Parent := Result;
          Caption := ButtonCaptions[B];
          ModalResult := ModalResults[B];
          if B = DefaultButton then begin
            Default := True;
            TabOrder:=0;
          end;
          if B = CancelButton then Cancel := True;
          SetBounds(X, IconTextHeight + VertMargin + VertSpacing,
            ButtonWidth, ButtonHeight);
          Inc(X, ButtonWidth + ButtonSpacing);
          if B = mbHelp then
            OnClick := TMessageForm(Result).HelpButtonClick;
        end;
  end;
end;

function MessageDlgPosHelp(owner:tform; const Msg: string; DlgType: TMsgDlgType;
  Buttons: TMsgDlgButtons; HelpCtx: Longint; X, Y: Integer;
  const HelpFileName: string; SelButton:TMsgDlgBtn): Integer;
begin
  with CreateMessageDialog(owner, Msg, DlgType, Buttons, SelButton) do
    try
      HelpContext := HelpCtx;
      HelpFile := HelpFileName;
      if X >= 0 then Left := X;
      if Y >= 0 then Top := Y;
      if (Y < 0) and (X < 0) then Position := poOwnerFormCenter;//poScreenCenter;
      Result := ShowModal;
    finally
      Free;
    end;
end;

function _messagedlg(owner:tcontrol;text:string;dlgtype:TMsgDlgType;selbutton:TMsgDlgBtn=mbOK):integer;
begin
  while not (owner is tform) do
    owner:=owner.Parent;
  if dlgtype=mtinformation then begin
    Result := MessageDlgPosHelp(owner as tform, text, mtinformation, [mbok], 0, -1, -1, '', selbutton);
  end else if dlgtype=mtConfirmation then begin
    Result := MessageDlgPosHelp(owner as tform, text, mtConfirmation, [mbYes, mbNo], 0, -1, -1, '', selbutton);
  end else if dlgtype=mtError then begin
    Result := MessageDlgPosHelp(owner as tform, text, mtError, [mbok], 0, -1, -1, '', selbutton);
  end else if dlgtype=mtCustom then begin
    Result := MessageDlgPosHelp(owner as tform, text, mtConfirmation, [mbYes, mbNo, mbCancel], 0, -1, -1, '', selbutton);
  end;
end;

end.
