unit uAutoFax;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, TimerLst, DBClient, StdCtrls, DB, ExtCtrls, Grids, DBGrids,
  ActnList, DBCtrls, DdeMan, DdeWinFaxConv, Registry, Printers, MConnect,
  SConnect, ComCtrls, QuickRpt;

type
  TfrmAutoFax = class(TForm)
    RxTimerList1: TRxTimerList;
    RxTimerEvent1: TRxTimerEvent;
    DdeWinFaxConv1: TDdeWinFaxConv;
    RxTimerEvent2: TRxTimerEvent;
    cdsQuery: TClientDataSet;
    StatusBar1: TStatusBar;
    Panel1: TPanel;
    Button2: TButton;
    Splitter1: TSplitter;
    listGrid: TStringGrid;
    dataGrid: TStringGrid;
    Button1: TButton;
    Button3: TButton;
    procedure RxTimerEvent1Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure RxTimerEvent2Timer(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure Button1Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    WaitState: boolean;
    procedure DBConnect;
    procedure DisplayData(FaxID: integer);
    procedure LoadFaxList;
    procedure RemoveSendLog(DeleteDay: integer = 30);
    procedure SetFaxParams(QR: TQuickRep; FaxNo, CompanyName, UserID: string);
    procedure SendReport01(FaxNo, CompanyName, UserID: string;
      List: TStrings);
    procedure SendReport02(FaxNo, CompanyName, UserID: string;
      List: TStrings);
    procedure SendReport03(FaxNo, CompanyName, UserID: string;
      List: TStrings);
    procedure SendReport04(FaxNo, CompanyName, UserID: string;
      List: TStrings);
    procedure SendReport(FaxID: integer);
    procedure RegistFaxReport(List: TStrings; ReportKind: integer;
      CompanyCode, FaxNo, UserID: string);
    procedure DeleteFaxData(FaxID: integer);
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmAutoFax: TfrmAutoFax;

implementation

uses uDMGlobal, uTrures_Result_FAX, Math, uQRReport01, uQRReport02,
  uQRReport03, uQRReport04;

{$R *.dfm}

///////////////////////////////////////////////////////////////////////////////

procedure TfrmAutoFax.FormCreate(Sender: TObject);
begin
  DBConnect;
  
  RxTimerList1.Active:= True;
  WaitState:= False;

  with listGrid do
  begin
    RowCount:= 2;  ColCount:= 8;
    Cells[0,0]:= '전송번호';    ColWidths[0]:= 60;
    Cells[1,0]:= '등록일시';    ColWidths[1]:= 80;
    Cells[2,0]:= '거래처코드';  ColWidths[2]:= 60;
    Cells[3,0]:= '거래처명';    ColWidths[3]:= 150;
    Cells[4,0]:= '보고서구분';  ColWidths[4]:= 60;
    Cells[5,0]:= '전송일시';    ColWidths[5]:= 80;
    Cells[6,0]:= '전송요청자';  ColWidths[6]:= 80;
    Cells[7,0]:= '팩스번호';    ColWidths[7]:= 80;
  end;    

  with dataGrid do
  begin
    RowCount:= 2;  ColCount:= 15;
    Cells[0,0]:= 'No';          ColWidths[0]:= 30;
    Cells[1,0]:= '등록일자';    ColWidths[1]:= 54;
    Cells[2,0]:= '등록번호';    ColWidths[2]:= 54;
    Cells[3,0]:= '수진자명';    ColWidths[3]:= 60;
    Cells[4,0]:= '거래코드';    ColWidths[4]:= 54;
    Cells[5,0]:= '거래처명';    ColWidths[5]:= 130;
    Cells[6,0]:= '주민번호';    ColWidths[6]:= 90;
    Cells[7,0]:= '차트번호';    ColWidths[7]:= 64;
    Cells[8,0]:= '청구수가';    ColWidths[8]:= 60;
    Cells[9,0]:= '담당';        ColWidths[9]:= 60;
    Cells[10,0]:= '진료과';     ColWidths[10]:= 60;
    Cells[11,0]:= '병동';       ColWidths[11]:= 60;
    Cells[12,0]:= '담당의사';   ColWidths[12]:= 60;
    Cells[13,0]:= '메모';       ColWidths[13]:= 60;
    Cells[14,0]:= '채취일자';   ColWidths[14]:= 60;
  end;

  LoadFaxList;
end;


//팩스전송
procedure TfrmAutoFax.RxTimerEvent1Timer(Sender: TObject);
var
  FaxID: integer;
  FaxNo, UserID: string;
begin
  Application.ProcessMessages;
  if WaitState then Exit;

  try
    WaitState:= True;

    with cdsQuery do
    begin
      Close;
      CommandText:= 'select top 1 f.*, c.company_name from alis_faxbox f, hcompany c'+
                    ' where f.company_code = c.company_code'+
                    ' and f.send_check = 0'+
                    ' and f.send_time < getdate()';
      Open;

      if not Eof then begin
         FaxID:= FieldByName('FAX_ID').AsInteger;
         FaxNo:= FieldByName('FAX_No').AsString;
         UserID:= FieldByName('Send_User').AsString;

         try
           //전송상태변환
           Close;
           CommandText:= 'update alis_faxbox set send_check = 1 where fax_id = '+IntToStr(FaxID);
           Execute;

           SendReport(FaxID);
           StatusBar1.Panels[1].Text:= '보낸이:'+Trim(UserID)+'   '+
                          '전송시간:'+FormatDateTime(LongTimeFormat,now)+'   '+
                          '팩스번호:'+FaxNo;
         except
           StatusBar1.Panels[0].Text:= '전송중 에러';
           DeleteFaxData(FaxID);
         end;

         Application.ProcessMessages;

         DisplayData(FaxID);
      end;
    end;

    Sleep(1000);
    LoadFaxList;
  finally
    WaitState:= False;
  end;
end;

procedure TfrmAutoFax.DeleteFaxData(FaxID: integer);
begin
  with cdsQuery do
  begin
    Close;
    CommandText:= 'delete alis_faxbox where fax_id = '''+IntToStr(FaxID)+'''';
    Execute;
  end;
end;

//자동팩스 리스트 등록
procedure TfrmAutoFax.RxTimerEvent2Timer(Sender: TObject);
var
  i: integer;
  List: TStringList;
  CompanyCode, FaxNo: string;
  procedure DeleteCompany;
  begin
     with cdsQuery do
     begin
       Close;
       CommandText:= 'delete ALIS_FAXList where company_code = '''+CompanyCode+'''';
       Execute;
     end;
  end;
begin
  Application.ProcessMessages;
  if WaitState then Exit;

  try
    WaitState:= True;

    with cdsQuery, dataGrid do
    begin
      //팩스리스트
      Close;
      CommandText:= 'select company_code from ALIS_FAXList'+
                    ' where trans_time <= '''+FormatDateTime('hhmm', Now)+''''+
                    ' and LastSendDate <> '''+FormatDateTime('YYYYMMDD', Now)+'''';
      Open;
      if not Eof then
         CompanyCode:= Trim(FieldByName('company_code').AsString)
      else Exit;

      //전송완료 체크
      Close;
      CommandText:= 'update ALIS_FAXList'+
                    ' set LastSendDate = '''+FormatDateTime('YYYYMMDD', Now)+''''+
                    ' where Company_Code = '''+CompanyCode+'''';
      Execute;

      //거래처정보
      Close;
      CommandText:= 'select company_code, company_use, fax_no from hcompany'+
                    ' where company_code = '''+CompanyCode+'''';
      Open;
      if not Eof then begin
         if not FieldByName('company_use').AsBoolean then begin
            DeleteCompany;
            Exit;
         end else FaxNo:= Trim(FieldByName('fax_no').AsString);
      end;

      if FaxNo = '' then Exit;


      //수탁데이터체크
      Close;
      CommandText:= 'select distinct t.request_date, t.exam_no, t.person_name, t.company_code,'+
                              ' c.company_name, t.personal_id, t.chart_no, c.lab_manager, t.exam_price,'+
                              ' t.dis_code1, t.dis_code2, t.dis_code3, t.trust_memo, e.code_name, t.result_date'+
                              ' from etccode e, hcompany c, examitem i, trust t, trures r'+
                              ' where t.request_date = r.request_date'+
                              ' and t.exam_no = r.exam_no'+
                              ' and t.company_code = c.company_code'+
                              ' and r.exam_code = i.exam_code'+
                              ' and i.exam_code <> ''X999'''+
                              ' and i.save_index = ''1'''+
                              ' and t.company_code = c.company_code'+
                              ' and e.detail_code = c.lab_manager'+
                              ' and e.master_code = ''120'''+
                              ' and t.request_date = '''+FormatDateTime('YYYYMMDD', Now - 1)+''''+
                              ' and t.company_code = '''+CompanyCode+''''+
                              ' order by t.request_date, t.exam_no';
      Open;
      if not (RecordCount > 0) then Exit;

      try
        List:= TStringList.Create;

        RowCount:= IfThen(RecordCount > 0, RecordCount + 1, 2);
        for i:= 0 to RecordCount - 1 do
        begin
          Cells[0, i+1]:= IntToStr(i+1);
          Cells[1, i+1]:= FieldByName('request_date').AsString;
          Cells[2, i+1]:= FieldByName('exam_no').AsString;
          Cells[3, i+1]:= Trim(FieldByName('person_name').AsString);
          Cells[4, i+1]:= Trim(FieldByName('company_code').AsString);
          Cells[5, i+1]:= Trim(FieldByName('company_name').AsString);

          if Trim(FieldByName('personal_id').AsString) <> '' then
             Cells[6, i+1]:= Copy(FieldByName('personal_id').AsString,1,6)+'-'+
                           Copy(FieldByName('personal_id').AsString,7,7)
          else
             Cells[6, i+1]:= '';

          Cells[7, i+1]:= Trim(FieldByName('chart_no').AsString);
          Cells[8, i+1]:= FormatFloat('#,##0', FieldByName('exam_price').AsInteger);
          Cells[9, i+1]:= Trim(FieldByName('lab_manager').AsString)+' '+Trim(FieldByName('code_name').AsString);

          Cells[10, i+1]:= Trim(FieldByName('dis_code1').AsString);
          Cells[11, i+1]:= Trim(FieldByName('dis_code2').AsString);
          Cells[12, i+1]:= Trim(FieldByName('dis_code3').AsString);
          Cells[13, i+1]:= Trim(FieldByName('trust_memo').AsString);
          Cells[14, i+1]:= Trim(FieldByName('result_date').AsString);

          List.Add(Rows[i+1].CommaText);
          Next;
        end;

        RegistFaxReport(List, 1, CompanyCode, FaxNo, '서버');
      finally
        FreeAndNil(List);
      end;
    end;

  finally
    WaitState:= False;
  end;
end;

procedure TfrmAutoFax.RegistFaxReport(List: TStrings; ReportKind: integer; CompanyCode, FaxNo, UserID: string);
begin
  with cdsQuery do
  begin
    Close;
    CommandText:= 'insert alis_faxbox'+
                  ' (company_code, report_kind, send_user, fax_no, data_list)'+
                  ' values'+
                  ' ('''+CompanyCode+''''+
                  ' ,'''+IntToStr(ReportKind)+''''+
                  ' ,'''+UserID+''''+
                  ' ,'''+FaxNo+''''+
                  ' ,'''+List.Text+''')';
    Execute;
  end;
end;

procedure TfrmAutoFax.LoadFaxList;
var
  i: integer;
begin
  with cdsQuery, listGrid do
  begin
    Close;
    CommandText:= 'select f.*, c.company_name from alis_faxbox f, hcompany c'+
                  ' where f.company_code = c.company_code'+
                  ' and f.send_check = 0 order by f.send_time';
    Open;

    RowCount:= IfThen(RecordCount > 0, RecordCount + 1, 2);
    for i:= 0 to ColCount - 1 do Cells[i, 1]:= '';

    for i:= 0 to RecordCount - 1 do
    begin
      Cells[0, i + 1]:= FieldByName('Fax_ID').AsString;
      Cells[1, i + 1]:= FieldByName('Regist_Time').AsString;
      Cells[2, i + 1]:= FieldByName('company_code').AsString;
      Cells[3, i + 1]:= FieldByName('Company_Name').AsString;
      case FieldByName('Report_Kind').AsInteger of
       1 : Cells[4, i + 1]:= '일반임상';
       2 : Cells[4, i + 1]:= '조직병리';
       3 : Cells[4, i + 1]:= '세포병리';
       4 : Cells[4, i + 1]:= 'PB Morp.';
      end;
      Cells[5, i + 1]:= FieldByName('Send_Time').AsString;
      Cells[6, i + 1]:= FieldByName('Send_User').AsString;
      Cells[7, i + 1]:= FieldByName('Fax_No').AsString;
      Next;
    end;

    Row:= 1;
  end;
end;

procedure TfrmAutoFax.DisplayData(FaxID: integer);
var
  sl: TStringList;
  i, j: integer;
begin
  if WaitState then Exit;
  
  try
    WaitState:= True;
    with dataGrid, cdsQuery do
    begin
      Close;
      CommandText:= 'select * from alis_faxbox where fax_id = '''+IntToStr(FaxID)+'''';
      Open;

      if not Eof then begin
      
         try
           sl:= TStringList.Create;
           sl.Text:= FieldByName('Data_List').AsString;
           RowCount:= sl.Count + 1;
           for i := 0 to sl.Count - 1 do
           begin
             Rows[i+1].CommaText:= sl[i];
           end;
         finally
           FreeAndNil(sl);
         end;
      end else begin
         RowCount:= 2;
         for i:= 0 to ColCount - 1 do Cells[i, 1]:= '';
      end;
    end;

    RemoveSendLog(30);
    
  finally
    WaitState:= False;
  end;
end;

procedure TfrmAutoFax.RemoveSendLog(DeleteDay: integer);
begin
  with cdsQuery do
  begin
    Close;
    CommandText:= 'delete alis_faxbox where send_time < getdate() - '+IntToStr(DeleteDay);
    Execute;
  end;
end;

procedure TfrmAutoFax.SetFaxParams(QR: TQuickRep; FaxNo, CompanyName, UserID: string);
var
  Reg: TRegIniFile;
  regdir: string;
begin
   //팩스모뎀 알아내기
    with Reg do
    begin
      Reg := TRegIniFile.Create;
      Reg.RootKey := HKEY_LOCAL_MACHINE;
      regDir:= 'SOFTWARE\SPLLAB\FaxModem';
      QR.PrinterSettings.PrinterIndex:= Printer.Printers.IndexOf(ReadString(regDir,'FaxModemName',''));
      DdeWinFaxConv1.SetWinFaxLink;
      DdeWinFaxConv1.DialAsEntered := ReadBool(regDir, 'DialAsEntered', True);
      DdeWinFaxConv1.DialPrefix := ReadString(regDir,'DialPrefix', '9,');
      DdeWinFaxConv1.LongDistancePrefix := ReadString(regDir,'LongDistancePrefix', '1');
      DdeWinFaxConv1.RemoveLocalAreaCode := ReadBool(regDir,'RemoveLocalAreaCode',False);
      DdeWinFaxConv1.LocalAreaCode := ReadString(regDir,'LocalAreaCode', '02');
      DdeWinFaxConv1.IncludeSendDateTime := ReadBool(regDir,'IncludeSendDateTime', False);
      Free;
    end;

    // SendFaxParams
    with DdeWinfaxConv1.SendFaxParams do begin
         PhoneNumber := FaxNo;
         SendDateTime := now;//전송시간
         RecipientName := FaxNo;//수취인 이름
         RecipientCompany := CompanyName;//수취인 회사
         Subject := CompanyName+' 보낸이:'+Trim(UserID); //제목
         Keywords := '';//키워드
         BillingCode := '';//청구코드
         BftFax := 'Fax';
    end;

    DdeWinFaxConv1.Execute;
end;

procedure TfrmAutoFax.SendReport(FaxID: integer);
var
  List: TStringList;
begin
  with cdsQuery do
  begin
    Close;
    CommandText:= 'select f.*, c.company_name from alis_faxbox f, hcompany c'+
                  ' where f.company_code = c.company_code'+
                  ' and f.fax_id = '+IntToStr(FaxID);
    Open;

    if not Eof then begin
       try
         List:= TStringList.Create;
         List.Text:= FieldByName('Data_List').AsString;
         case FieldByName('Report_kind').AsInteger of
          1 : SendReport01(FieldByName('Fax_No').AsString,
              '['+Trim(FieldByName('Company_Code').AsString)+'] '+Trim(FieldByName('Company_Name').AsString),
              FieldByName('Send_User').AsString, List);

          2 : SendReport02(FieldByName('Fax_No').AsString,
              '['+Trim(FieldByName('Company_Code').AsString)+'] '+Trim(FieldByName('Company_Name').AsString),
              FieldByName('Send_User').AsString, List);

          3 : SendReport03(FieldByName('Fax_No').AsString,
              '['+Trim(FieldByName('Company_Code').AsString)+'] '+Trim(FieldByName('Company_Name').AsString),
              FieldByName('Send_User').AsString, List);

          4 : SendReport04(FieldByName('Fax_No').AsString,
              '['+Trim(FieldByName('Company_Code').AsString)+'] '+Trim(FieldByName('Company_Name').AsString),
              FieldByName('Send_User').AsString, List);
         end;
       finally
         FreeAndNil(List);
       end;
    end;
  end;
end;

procedure TfrmAutoFax.SendReport01(FaxNo, CompanyName, UserID: string; List: TStrings);
var
  QR: TQRReport01;
begin
  try
    QR:= TQRReport01.Create(self);
    QR.PrintList.Assign(List);
    QR.PrintDate:= Now;
    QR.ShowCaption:= True;
    SetFaxParams(QR, FaxNo, CompanyName, UserID);
    QR.Print;
  finally
    FreeAndNil(QR);
  end;
end;

procedure TfrmAutoFax.SendReport02(FaxNo, CompanyName, UserID: string; List: TStrings);
var
  QR: TQRReport02;
begin
  try
    QR:= TQRReport02.Create(self);
    QR.PrintList.Assign(List);
    QR.PrintDate:= Now;
    QR.ShowCaption:= True;
    SetFaxParams(QR, FaxNo, CompanyName, UserID);
    QR.Print;
  finally
    FreeAndNil(QR);
  end;
end;

procedure TfrmAutoFax.SendReport03(FaxNo, CompanyName, UserID: string; List: TStrings);
var
  QR: TQRReport03;
begin
  try
    QR:= TQRReport03.Create(self);
    QR.PrintList.Assign(List);
    QR.PrintDate:= Now;
    QR.ShowCaption:= True;
    SetFaxParams(QR, FaxNo, CompanyName, UserID);
    QR.Print;
  finally
    FreeAndNil(QR);
  end;
end;

procedure TfrmAutoFax.SendReport04(FaxNo, CompanyName, UserID: string; List: TStrings);
var
  QR: TQRReport04;
begin
  try
    QR:= TQRReport04.Create(self);
    QR.PrintList.Assign(List);
    QR.PrintDate:= Now;
    QR.ShowCaption:= True;
    SetFaxParams(QR, FaxNo, CompanyName, UserID);
    QR.Print;
  finally
    FreeAndNil(QR);
  end;
end;

procedure TfrmAutoFax.Button2Click(Sender: TObject);
begin
  if (Sender as TButton).Caption = '정지' then begin
     RxTimerList1.Active:= False;
     StatusBar1.Panels[0].Text:= '팩스서버 정지..';
     (Sender as TButton).Caption:= '시작'
  end else begin
     RxTimerList1.Active:= True;
     StatusBar1.Panels[0].Text:= '팩스서버 구동중..';
     (Sender as TButton).Caption:= '정지'
  end;
end;

procedure TfrmAutoFax.DBConnect;
begin
  if not Assigned(DMGlobal) then DMGlobal:= TDMGlobal.Create(self);

  if not DMGlobal.ConnectionBroker1.Connected then begin
     DMGlobal.ConnectionBroker1.Connection:= DMGlobal.Socket_0;
     DMGlobal.ConnectionBroker1.Open;
  end;
end;

procedure TfrmAutoFax.FormCloseQuery(Sender: TObject;
  var CanClose: Boolean);
begin
  CanClose:= MessageDlg('자동팩스프로그램을 종료하면 팩스가 전송되질 않습니다.'+CRLF+CRLF+
                        '종료하시겠습니까?',mtWarning,[mbYes,mbNo],0) = mrYes;
end;

procedure TfrmAutoFax.Button1Click(Sender: TObject);
begin
  if listGrid.Cells[0, listGrid.Row] = '' then Exit;
     DisplayData(StrToInt(listGrid.Cells[0, listGrid.Row]));
end;

procedure TfrmAutoFax.Button3Click(Sender: TObject);
begin
  DeleteFaxData(StrToIntDef(listGrid.Cells[0, listGrid.Row], 0));
  Application.ProcessMessages;
  LoadFaxList;
end;

end.


입니다... 제가 만든건 아니고요 인수인계받은건데 만든지 한 10년 되셨다고 하시더라고요

참고로 전 델파이에 ㄷ 자도 모르는 쌩초보인데 실행시키면

window socket error 10060 on APL connect (또는 10061) 뜹니다

win98이구요 DB접속해서 winfax로 자동팩스를 보내주는 autofax입니다.

어떤게 문제가 있는건가요? 이것때문에 일주일 야근했는데 해결 방법을 모르겠네요

DB소켓도 다 열었구 아에 방화벽을 꺼버렸습니다. 해볼만한건 다 해봤습니다

프로그램이 문제가 있을것 같아서요 잘 쓰다가 안되서 포맷해서 다시깔았는데 안되네요