unit ReportWin;

{$WARN UNIT_PLATFORM OFF}
{$WARN SYMBOL_PLATFORM OFF}

interface

uses
  Windows, SysUtils, Forms, Dialogs, ClipBrd, _netconst,_m_Tools,
  IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdMessageClient, IdSMTP,
  Classes, Controls, StdCtrls, ComCtrls, ExtCtrls;

type
  TMain = class(TForm)
    PageCtrl: TPageControl;
    Page0Tab: TTabSheet;
    BasicSubjectEdt: TLabeledEdit;
    BasicUserNameEdt: TLabeledEdit;
    BasicMailAddressEdt: TLabeledEdit;
    Page1Tab: TTabSheet;
    EnvOSLst: TComboBox;
    Label1: TLabel;
    EnvDXLst: TComboBox;
    Label2: TLabel;
    EnvSCEdt: TLabeledEdit;
    EnvMemLst: TComboBox;
    Label5: TLabel;
    EnvCorpEdt: TLabeledEdit;
    EnvGCEdt: TLabeledEdit;
    EnvPixelEdt: TLabeledEdit;
    Label3: TLabel;
    EnvAccLst: TComboBox;
    Label4: TLabel;
    EnvCPULst: TComboBox;
    Label6: TLabel;
    EnvClockLst: TComboBox;
    Label7: TLabel;
    Label8: TLabel;
    Page2Tab: TTabSheet;
    ErrAppLst: TComboBox;
    Label9: TLabel;
    ErrSummaryLst: TComboBox;
    Label10: TLabel;
    Label11: TLabel;
    ErrDetailsMemo: TMemo;
    Page3Tab: TTabSheet;
    AddCurrentFilenameChk: TCheckBox;
    AddMDXWinChk: TCheckBox;
    AddMDXErrorChk: TCheckBox;
    AddNetworkChk: TCheckBox;
    AddOnlineUpdateChk: TCheckBox;
    AddMDXWin200overChk: TCheckBox;
    Page4Tab: TTabSheet;
    MailPreviewMemo: TMemo;
    Label12: TLabel;
    Label13: TLabel;
    Label14: TLabel;
    ErrFNEdt: TLabeledEdit;
    Label15: TLabel;
    Label16: TLabel;
    Label17: TLabel;
    ClearBtn: TButton;
    NextBtn: TButton;
    BackBtn: TButton;
    CloseBtn: TButton;
    Label18: TLabel;
    Label19: TLabel;
    MailCopyBtn: TButton;
    Label20: TLabel;
    ErrVerEdt: TLabeledEdit;
    IdSMTP: TIdSMTP;
    MailSendBtn: TButton;
    AddTerminalChk: TCheckBox;
    procedure FormCreate(Sender: TObject);
    procedure ClearBtnClick(Sender: TObject);
    procedure CloseBtnClick(Sender: TObject);
    procedure NextBtnClick(Sender: TObject);
    procedure BackBtnClick(Sender: TObject);
    procedure MailCopyBtnClick(Sender: TObject);
    procedure PageCtrlChange(Sender: TObject);
    procedure MailSendBtnClick(Sender: TObject);
  private
    { Private 宣言 }
    procedure AllClear;
    procedure ChangePage;
  public
    { Public 宣言 }
  end;

var
  Main: TMain;

implementation

{$R *.dfm}

procedure TMain.FormCreate(Sender: TObject);
begin
  Main.Caption:='障害報告メール作成ウィザード';
  AllClear;
end;

procedure TMain.AllClear;
  function GetPixelInfo:string;
  begin
    Result:=format('%dx%dpixels',[Screen.Width,Screen.Height]);
  end;
begin
  BasicSubjectEdt.Text:='@MDXWin障害報告メール';
  BasicUserNameEdt.Text:='';
  BasicMailAddressEdt.Text:='';

  EnvCorpEdt.Text:='不明';
  EnvOSLst.ItemIndex:=0;
  EnvDXLst.ItemIndex:=0;
  EnvSCEdt.Text:='不明';
  EnvMemLst.ItemIndex:=0;
  EnvGCEdt.Text:='不明';
  EnvPixelEdt.Text:=GetPixelInfo;
  EnvAccLst.ItemIndex:=0;
  EnvCPULst.ItemIndex:=0;
  EnvClockLst.ItemIndex:=0;

  ErrAppLst.ItemIndex:=0;
  ErrVerEdt.Text:='不明';
  ErrSummaryLst.ItemIndex:=0;
  ErrDetailsMemo.Text:='';
  ErrFNEdt.Text:='';

  AddCurrentFilenameChk.Checked:=True;
  AddMDXWinChk.Checked:=True;
  AddMDXErrorChk.Checked:=True;
  AddNetworkChk.Checked:=True;
  AddTerminalChk.Checked:=True;
  AddOnlineUpdateChk.Checked:=True;
  AddMDXWin200overChk.Checked:=True;

  MailPreviewMemo.Text:='';

  PageCtrl.ActivePageIndex:=0;
  ChangePage;
end;

procedure TMain.ClearBtnClick(Sender: TObject);
begin
  if MessageDlg('入力された情報をクリアしてもよろしいですか？',mtConfirmation,[mbYes,mbNo],0)=mrNo then exit;
  AllClear;
end;

procedure TMain.CloseBtnClick(Sender: TObject);
begin
  if MessageDlg('レポートの作成を中止してもよろしいですか？',mtConfirmation,[mbYes,mbNo],0)=mrNo then exit;

  Main.Close;
end;

procedure TMain.NextBtnClick(Sender: TObject);
begin
  if PageCtrl.ActivePageIndex<=(PageCtrl.PageCount-2) then begin
    PageCtrl.ActivePageIndex:=PageCtrl.ActivePageIndex+1;
    ChangePage;
  end;
end;

procedure TMain.BackBtnClick(Sender: TObject);
begin
  if PageCtrl.ActivePageIndex>=1 then begin
    PageCtrl.ActivePageIndex:=PageCtrl.ActivePageIndex-1;
    ChangePage;
  end;
end;

procedure TMain.ChangePage;
var
  msg:string;
  procedure ad(_msg1,_msg2:string);
  begin
    _msg2:=trim(_msg2);
    if _msg2='不明' then _msg2:='';

    if (_msg1='') and (_msg2='') then msg:=msg+CRLF;
    if (_msg1='') and (_msg2<>'') then msg:=msg+_msg2+CRLF;
    if (_msg1<>'') and (_msg2='') then begin end;
    if (_msg1<>'') and (_msg2<>'') then msg:=msg+_msg1+'='+_msg2+CRLF;
  end;
  procedure AddFileList(chk:TCheckBox;path:string);
  var
    res:integer;
    SearchRec: TSearchRec;
    fsize:integer;
  begin
    if Chk.Checked=False then exit;

    msg:=msg+CRLF+'[CurrentFileList]'+CRLF+CRLF;

    res:=FindFirst(path+'*.*', (faDirectory or faReadOnly or faHidden or faSysFile or faArchive), SearchRec);

    if res=0 then begin
      repeat
        if (SearchRec.Attr and faDirectory)<>0 then begin
          msg:=msg+'"['+SearchRec.Name+']"'+CRLF;
          end else begin
          fsize:=GetFileSize(path+SearchRec.Name);
          msg:=msg+'"'+SearchRec.Name+'",'+inttostr(fsize)+CRLF;
        end;
        res:=FindNext(SearchRec);
      until (res<>0);
    end;
    FindClose(SearchRec);
  end;
  procedure AddFile(chk:TCheckBox;Filename:string);
  var
    fs:TFileStream;
    t:string;
  begin
    if Chk.Checked=False then exit;

    msg:=msg+CRLF+'['+Filename+']'+CRLF+CRLF;
    if FileExists(Filename)=False then begin
      msg:=msg+'not exists.'+CRLF;
      exit;
    end;
    fs:=TFileStream.Create(Filename,fmOpenRead or fmShareDenyWrite);
    t:=StringOfChar(' ',fs.Size);
    fs.ReadBuffer(t[1],fs.Size);
    fs.free;
    if length(t)>20480 then begin
      t:=copy(t,length(t)-20480,20480);
    end;
    msg:=msg+t+CRLF;
  end;
begin
  if PageCtrl.ActivePageIndex=0 then begin
    BackBtn.Enabled:=False;
    end else begin
    BackBtn.Enabled:=True;
  end;
  if PageCtrl.ActivePageIndex=(PageCtrl.PageCount-1) then begin
    NextBtn.Enabled:=False;
    end else begin
    NextBtn.Enabled:=True;
  end;

  if PageCtrl.ActivePageIndex=(PageCtrl.PageCount-1) then begin
    ad('','');
    ad('','[Basic]');
    ad('','');
    ad('Subject',BasicSubjectEdt.Text);
    ad('Username',BasicUserNameEdt.Text);
    ad('MailAddress',BasicMailAddressEdt.Text);

    ad('','');
    ad('','[Environment]');
    ad('','');
    ad('CorpPC',EnvCorpEdt.Text);;
    ad('OS',EnvOSLst.Text);
    ad('DirectX',EnvDXLst.Text);
    ad('CPU',EnvCPULst.Text);
    ad('Clock',EnvClockLst.Text);
    ad('Memory',EnvMemLst.Text);
    ad('SoundCard',EnvSCEdt.Text);
    ad('GraphicCard',EnvGCEdt.Text);
    ad('Pixel',EnvPixelEdt.Text);
    ad('SoundAccelerator',EnvAccLst.Text);

    ad('','');
    ad('','[Error]');
    ad('','');
    ad('Application',ErrAppLst.Text);
    ad('Version',ErrVerEdt.Text);
    ad('Filename',ErrFNEdt.Text);
    ad('Summary',ErrSummaryLst.Text);

    ad('','');
    ad('','[ErrorDetails]');
    ad('','');
    ad('',ErrDetailsMemo.Text);

    AddFileList(AddCurrentFilenameChk,ExtractFilePath(Application.ExeName));
    AddFile(AddMDXWinChk,'MDXWin.ini');
    AddFile(AddMDXErrorChk,'MDXError.log');
    AddFile(AddNetworkChk,'network.log');
    AddFile(AddTerminalChk,'Terminal.log');
    AddFile(AddOnlineUpdateChk,'OnlineUpdate.log');
    AddFile(AddMDXWin200overChk,'MDXWin200over.upd');

    MailPreviewMemo.Text:=msg;
  end;
end;

procedure TMain.MailCopyBtnClick(Sender: TObject);
var
  cb:TClipBoard;
begin
  cb:=TClipBoard.Create;
  cb.AsText:=MailPreviewMemo.Text;
  cb.Free;

  ShowMessage('メール内容をクリップボードにコピーしました。');
end;

procedure TMain.PageCtrlChange(Sender: TObject);
begin
  ChangePage;
end;

procedure TMain.MailSendBtnClick(Sender: TObject);
begin
  if MessageDlg('以上の内容で障害メールを送信してもよろしいですか？',mtConfirmation,[mbYes,mbNo],0)=mrNo then exit;
  IdSMTP.QuickSend('tkb.att.ne.jp',BasicSubjectEdt.Text,'monlight@tkb.att.ne.jp',BasicMailAddressEdt.Text,MailPreviewMemo.Text);
  ShowMessage('メールの送信が完了しました。本当にありがとうございました。');
end;

end.
