문자 메시지 전송(sms)

unit xSMSSuremCall;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, Menus, StdCtrls, Buttons, IniFiles, xEdit, DB, ApoDSet, Registry,
  OleServer, ShellAPI, SMSCALLLib_TLB;


type
  TFormSMSSuremCall = class(TForm)
    Image2: TImage;
    MemoMessage: TMemo;
    ImageMessageLoad: TImage;
    ImageSendOK: TImage;
    ImageSendCancel: TImage;
    ImageMessageSave: TImage;
    GroupBox1: TGroupBox;
    Label20: TLabel;
    xEditID: TxEdit;
    Label22: TLabel;
    xEditPASS: TxEdit;
    SpeedButtonLogin: TSpeedButton;
    GroupBox2: TGroupBox;
    RadioButtonS0: TRadioButton;
    RadioButtonS1: TRadioButton;
    xEditDate: TxEdit;
    Label1: TLabel;
    xEditTime: TxEdit;
    Label2: TLabel;
    CheckBoxAuto: TCheckBox;
    CheckBoxShow: TCheckBox;
    GroupBox4: TGroupBox;
    SpeedButtonCashRefer: TSpeedButton;
    SpeedButtonClose: TSpeedButton;
    SpeedButtonHelp: TSpeedButton;
    SpeedButtonMessage: TSpeedButton;
    Label3: TLabel;
    Label4: TLabel;
    LabelCost: TLabel;
    LabelCount: TLabel;
    ApolloDataSetSLSMS: TApolloDataSet;
    xEditTo: TxEdit;
    xEditFrom: TxEdit;
    SpeedButtonSystem: TSpeedButton;
    LabelMessage: TLabel;
    ListBoxNames: TListBox;
    CheckBoxDupe: TCheckBox;
    objSMS: TSMSCALLMSG;
    Label5: TLabel;
    LabelDanga: TLabel;
    SpeedButtonPayMent: TSpeedButton;
    SpeedButtonResult: TSpeedButton;
    SpeedButtonJoin: TSpeedButton;
    procedure SpeedButtonCloseClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormShow(Sender: TObject);
    procedure CheckBoxShowClick(Sender: TObject);
    procedure SpeedButtonMessageClick(Sender: TObject);
    procedure ImageMessageLoadClick(Sender: TObject);
    procedure ImageMessageSaveClick(Sender: TObject);
    procedure ImageSendCancelClick(Sender: TObject);
    procedure ImageSendOKClick(Sender: TObject);
    procedure SpeedButtonCashReferClick(Sender: TObject);
    procedure SpeedButtonHelpClick(Sender: TObject);
    procedure SpeedButtonSystemClick(Sender: TObject);
    procedure MemoMessageChange(Sender: TObject);
    procedure SpeedButtonLoginClick(Sender: TObject);
    procedure SpeedButtonJoinClick(Sender: TObject);
    procedure SpeedButtonPayMentClick(Sender: TObject);
    procedure SpeedButtonResultClick(Sender: TObject);
  private
    { Private declarations }
    g_UserCode,
    g_UserPass,
    g_DeptCode,
    g_DeptName,
    g_UserName,
    g_ReqPhone1, g_ReqPhone2, g_ReqPhone3 : WideString;

    g_TotPrice,
    g_CallPrice : LongInt;

    TeleArray : array[1..19999,1..2] of string;
    TeleIndex : integer;

    procedure DllRegister;
    procedure Button2Disabled;
    procedure Button2Enabled;
    procedure SaveInformation;
    procedure PassWordShow;
    procedure ShowCash;
    procedure SendMessage;
    procedure SendMessageOne(pFPhone,pMemo,pRDate,pRTime:string);
    procedure SendMessageAll(pFPhone,pMemo,pRDate,pRTime:string);
    procedure Mobile3Number(pOrgNumber:string; var rP1,rP2,rP3:string);

    function  LoginProgress(pMessageShow:Boolean):Boolean;    
    function  CheckFound(pTele,pName:string):Boolean;
  public
    { Public declarations }
    pFromOK : Boolean;
  end;

var
  FormSMSSuremCall: TFormSMSSuremCall;

implementation

uses xModule, xServer, xLibComm, xProgressTerm, xSMSMessage, xSMSMsgItem, xSMSSuremLib;

{$R *.dfm}


procedure TFormSMSSuremCall.FormCreate(Sender: TObject);
begin
    xReadPosition(Self,'SureM',170,130);
end;

procedure TFormSMSSuremCall.FormShow(Sender: TObject);
begin
    DllRegister;
    
    CheckBoxAuto.Checked  := xIF(xReadString('SureM','UserAuto','N')='Y',True,False);;
    CheckBoxShow.Checked  := xIF(xReadString('SureM','UserShow','N')='Y',True,False);;
    CheckBoxDupe.Checked  := xIF(xReadString('SureM','UserDupe','N')='Y',True,False);;

    xEditID.Text          := LibSuremUserID;
    xEditPASS.Text        := LibSuremUserPASS;

    xEditDate.Text        := FormatDateTime('YYYY.MM.DD',Now);
    xEditTime.Text        := FormatDateTime('HH:MM',Now);

    if not pFromOK then  xEditFrom.Text := xReadString('SureM','SENDFROM',xINISPACE);

    LabelCost.Caption      := '0';
    LabelCount.Caption     := '0';

    Button2Disabled;

    if CheckBoxAuto.Checked then LogInProgress(False);

    if SpeedButtonCashRefer.Enabled then ShowCash;
end;

procedure TFormSMSSuremCall.FormClose(Sender: TObject; var Action: TCloseAction);
begin
    xWritePosition(Self,'SureM',Top,Left);

    xWriteString('SureM','UserAuto',xIF(CheckBoxAuto.Checked,'Y','N'));
    xWriteString('SureM','UserShow',xIF(CheckBoxShow.Checked,'Y','N'));
    xWriteString('SureM','UserDupe',xIF(CheckBoxDupe.Checked,'Y','N'));

    if not pFromOK then xWriteString('SureM','SENDFROM',xEditFrom.Text);
end;

//------------

procedure TFormSMSSuremCall.Mobile3Number(pOrgNumber:string; var rP1,rP2,rP3:string);
begin
    if Length(pOrgNumber) = 11 then   // 010 7655 1713
       begin
           rP1 := COPY(pOrgNumber,1,3);
           rP2 := COPY(pOrgNumber,4,4);
           rP3 := COPY(pOrgNumber,8,4);
       end else
    if Length(pOrgNumber) = 10 then  // 017 205 1713
       begin
           rP1 := COPY(pOrgNumber,1,3);
           rP2 := COPY(pOrgNumber,4,3);
           rP3 := COPY(pOrgNumber,7,4);
       end
    else
       begin
           rP1 := COPY(pOrgNumber,1,3);
           rP2 := COPY(pOrgNumber,4,3);
           rP3 := COPY(pOrgNumber,7,length(pOrgNumber)-6);
       end;
end;

procedure TFormSMSSuremCall.DllRegister;
var Registry: TRegistry;
    S: string;
begin
    Registry:=TRegistry.Create;
    Registry.RootKey := HKEY_CLASSES_ROOT;
    Registry.OpenKey('SMSCALL.SMSCALLMSG',False);
    S := Registry.ReadString('');
    Registry.Free;

    if Length( Trim(s) ) < 10 then begin
       xMSG('SMSCall.DLL 이 레지스터에 등록되어있지 않습니다.'+#13+
            '확인버튼을 누르면 레지스터 등록작업을 수행합니다.');

       xRegister(ExtractFilePath(ParamStr(0))+'SMSCall.DLL');
    end;
end;

procedure TFormSMSSuremCall.SendMessage;
{ 문자전송 }
var sRDate     : string;
    sRTime     : string;
    sFPhone    : string;
    sMemo      : string;
begin
    if RadioButtonS0.Checked then
       begin
           sRDate := '00000000';
           sRTime := '000000';
       end
    else
       begin
           sRDate := COPY(xEditDate.Text,1,4)+COPY(xEditDate.Text,6,2)+COPY(xEditDate.Text,9,2);
           sRTime := COPY(xEditTime.Text,1,2)+COPY(xEditTime.Text,4,2)+'00';
       end;

    sFPhone := xNumOnly(xEditFrom.Text);

    sMemo   := xMemo2String(MemoMessage,16);

    if Length(sMemo) > 80 then sMemo := COPY(sMemo,1,80);

    if xEmpty(sFPhone) then begin
       xMsg('오류 : 보낼사람 전화번호가 공백이면 안됩니다');

       Exit;
    end;

    if xEmpty(MemoMessage.Text) then begin
       xMsg('오류 : 보낼 메세지가 공백이면 안됩니다');

       Exit;
    end;

    if COPY(xEditTo.Text,1,8) = '단체발송' then SendMessageAll(sFPhone,sMemo,sRDate,sRTime)
                                           else SendMessageOne(sFPhone,sMemo,sRDate,sRTime);

    ShowCash;
end;

procedure TFormSMSSuremCall.SendMessageAll(pFPhone,pMemo,pRDate,pRTime:string);
var MyProgress : TFormProgressTerm;
    inc        : integer;
    sTPhone    : string;
    sTName     : string;
    nDupe      : integer;
    nFail      : integer;
    nRet       : integer;
    nSocket    : integer;

    sTP1, sTP2, sTP3 : string;
    sFP1, sFP2, sFP3 : string;
begin
    nDupe := 0;      // 중복된 갯수
    nFail := 0;      // 실패한 갯수

    TeleIndex := 0;  // 전체전송할 자료갯수

    //-- 단체발송에서 중복제외
    if CheckBoxDupe.Checked then
       for inc := 1 to ListBoxNames.Items.Count do begin
           sTPhone := COPY(ListBoxNames.Items[inc-1],10,16);
           sTPhone := xNumOnly(sTPhone);

           sTName  := COPY(ListBoxNames.Items[inc-1],26,Length(ListBoxNames.Items[inc-1])-25);

           // 중복된 번호
           if CheckFound(sTPhone,sTName) then begin
              nDupe := nDupe + 1;

              ListBoxNames.Items[inc-1] := '*'+COPY(ListBoxNames.Items[inc-1],2,Length(ListBoxNames.Items[inc-1]));
           end;
       end
    else
       for inc := 1 to ListBoxNames.Items.Count do begin
           sTPhone := COPY(ListBoxNames.Items[inc-1],10,16);
           sTPhone := xNumOnly(sTPhone);

           TeleArray[inc,1] := sTPhone;
           TeleArray[inc,2] := COPY(ListBoxNames.Items[inc-1],26,Length(ListBoxNames.Items[inc-1])-25);

           TeleIndex := inc;
       end;


    nSocket := objSMS.SMSConnect();

    If nSocket < 0 then begin
       xMsg('문자메세지 서버에 접속이 안됩니다.'+#13+#13+
            '잠시후에 다시 시도하십시오.');

       Exit;
    end;

    MyProgress := TFormProgressTerm.Create(Application);
    MyProgress.Show;
    MyProgress.Title('단체발송 처리중입니다.');
    MyProgress.MaxValue(TeleIndex);

    for inc := 1 to TeleIndex do begin
        MyProgress.Progress( inc );
        MyProgress.UpDate;

        if MyProgress.StatTerm then Break;


        Mobile3Number(pFPhone         ,sFP1,sFP2,sFP3);
        Mobile3Number(TeleArray[inc,1],sTP1,sTP2,sTP3);

        nRet:= objSMS.SMSSend(nSocket, TeleIndex, inc, inc, g_UserCode, g_UserName, g_DeptCode, g_UserName,
                              sTP1, sTP2, sTP3, inttostr(inc)+') '+Trim(TeleArray[inc,2]),
                              sFP1, sFP2, sFP3,
                              pMemo, pRDate, pRTime, g_TotPrice, g_CallPrice);

        If nRet <> 1 then nFail := nFail + 1;
    end;

    MyProgress.Free;

    ShowCash;

    xMsg('문자메세지 전송을 완료하였습니다'+#13+
         xIF(nDupe>0,IntToStr(nDupe)+'개의 자료가 중복되어 발송에서 제외되었습니다','')+#13+
         xIF(nFail>0,IntToStr(nFail)+'개의 자료가 전송시에 오류가 발생하였습니다','')+#13+
        '성공여부는 [전송결과조회]에서 확인이 가능합니다');
end;

procedure TFormSMSSuremCall.SendMessageOne(pFPhone,pMemo,pRDate,pRTime:string);
var sTPhone : string;
    sTName  : string;
    nRet    : integer;

    sTP1, sTP2, sTP3 : string;
    sFP1, sFP2, sFP3 : string;
begin
    sTPhone := xNumOnly(xEditTo.Text);

    if xEmpty(sTPhone) or ( Length(sTPhone) < 10 ) then begin
       xMsg('오류 : 받을사람 전화번호가 올바르지 않습니다');

       Exit;
    end;

    Mobile3Number(pFPhone,sFP1,sFP2,sFP3);
    Mobile3Number(sTPhone,sTP1,sTP2,sTP3);

    //-- 리스트박스에 수신자의 이름이 넘겨온 경우인지
    if ListBoxNames.Items.Count = 0 then sTName := xEditTo.Text
                                    else sTName := COPY(ListBoxNames.Items[0],26,Length(ListBoxNames.Items[0])-25);

    nRet:= objSMS.SMSSendUnit(0, g_UserCode, g_UserPass, g_DeptCode, pFPhone,
                              sTP1, sTP2, sTP3, sTName,
                              sFP1, sFP2, sFP3,
                              pMemo, pRDate, pRTime, g_TotPrice, g_CallPrice);
    case nRet of
         1 : xMsg('문자메세지 전송을 완료하였습니다.'+#13+#13+
                  '전송내역은 홈페이지(www.surem.com)에서 확인이 가능합니다');
        11 : xMsg('전송실패: 전화번호이상');
        21 : xMsg('전송실패: Connect 실패');
        23 : xMsg('전송실패: 데이터 Send 실패');
        40 : xMsg('전송실패: Ack Receive 실패');
        67 : xMsg('전송실패: 잔액부족');
        68 : xMsg('전송실패: 고객사 코드 이상');
        73 : xMsg('전송실패: 미등록회원');
        77 : xMsg('전송실패: 메세지의 내용이 없음');
        78 : xMsg('전송실패: 전화번호에 문제가 있음');
        80 : xMsg('전송실패: 이동통신사번호이상');
        82 : xMsg('전송실패: 700, 800 금지업체');
        84 : xMsg('전송실패: 예약일자이상');
        85 : xMsg('전송실패: 호출 URL 이상');
        99 : xMsg('전송실패: 데이타포맷오류');

        else xMsg('문자메세지 전송이 실패하였습니다.'+#13+#13+
                  '전송내역은 홈페이지(www.surem.com)에서 확인이 가능합니다');
    end;

    ShowCash;
end;

function  TFormSMSSuremCall.CheckFound(pTele,pName:string):Boolean;
var inc    : integer;
    rFound : Boolean;
begin
    rFound := False;

    for inc := 1 to TeleIndex do begin
        if pTele = TeleArray[inc,1] then begin
           rFound := True;

           Break;
        end;
    end;

    if rFound = False then begin
       TeleIndex := TeleIndex  + 1;

       TeleArray[TeleIndex,1] := pTele;
    end;

    Result := rFound;
end;

procedure TFormSMSSuremCall.ShowCash;
var nRet: integer;
    szType, szBasicYN: WideString;
    nBasicCnt, nBasicLeft: LongInt;
begin
    szType:='s';

    nRet:= objSMS.CashCheck(g_UserCode, g_UserPass, g_DeptCode, szType,
                           g_TotPrice, g_CallPrice, szBasicYN, nBasicCnt, nBasicLeft);

    if nRet = 1 then
       begin
           LabelCost.Caption  := Trim(FormatFloat('###,###',g_TotPrice));
           LabelCount.Caption := Trim(FormatFloat('###,###',g_TotPrice / g_CallPrice));
           LabelDanga.Caption := Trim(FormatFloat('###,###',g_CallPrice));
       end
    else xMsg('현재 잔액조액가 안됩니다. 잠시후에 다시 시도하십시오');
end;

procedure TFormSMSSuremCall.Button2Disabled;
begin
    SpeedButtonCashRefer.Enabled   := False;
end;

procedure TFormSMSSuremCall.Button2Enabled;
begin
    SpeedButtonCashRefer.Enabled   := True;
end;

procedure TFormSMSSuremCall.SaveInformation;
var MyIni    : TIniFile;
    UserDir  : string;
    UserFile : string;
begin
    UserDir  := ExtractFilePath(ParamStr(0))+'LOG';
    UserFile := UserDir+'\SLUSER.INI';

    if not DirectoryExists(UserDir) then CreateDir(UserDir);

    MyIni := TIniFile.Create(UserFile);
    MyIni　.Write　String('SureM','UserID'  ,xEditID.Text);
    MyIni　.Write　String('SureM','UserPASS',xEditPASS.Text);
    MyIni.Free;
end;

procedure TFormSMSSuremCall.PasswordShow;
begin
    if CheckBoxShow.Checked then xEditPASS.PasswordChar := #0
                            else xEditPASS.PasswordChar := '*';
end;

function TFormSMSSuremCall.LogInProgress(pMessageShow:Boolean):Boolean;
var nRet: LongInt;
begin
    if xEmpty(xEditID.Text+xEditPASS.Text) then begin
       xMsg('오류 : 아이디/패스워드가 공백이면 안됩니다');

       Result := False;

       Exit;
    end;

    g_UserCode   := Trim(xEditID.Text);
    g_UserPass   := Trim(xEditPASS.Text);
    g_DeptCode   := 'K9-HPY-PC';
    g_DeptName   := 'swmake';

    nRet:= objSMS.SMSLogin(g_UserCode, g_UserPass, g_DeptCode,
                           g_UserName, g_ReqPhone1, g_ReqPhone2, g_ReqPhone3, g_TotPrice, g_CallPrice);

    Button2Disabled;

    case nRet of                                                   
         1 : begin
                 Button2Enabled;

                 LabelCost.Caption  := Trim(FormatFloat('###,###',g_TotPrice));
                 LabelCount.Caption := Trim(FormatFloat('###,###',g_TotPrice / g_CallPrice));
                 LabelDanga.Caption := Trim(FormatFloat('###,###',g_CallPrice));

                 if pMessageShow then xMSG(#13+'로그인에 성공하였습니다.'+#13+#13);
             end;
        21 : xMsg('로그인: Connent 실패');
        22 : xMsg('로그인: 데이터 Send 실패');
        23 : xMsg('로그인: Ack Receive 실패');
        40 : xMsg('로그인: SMS 서버 이상');
        41 : xMsg('로그인: 아이디 미등록 사용자');
        99 : xMsg('로그인: 패스워드가 틀립니다');
        else xMsg('로그인: 로그인을 실패하였습니다');
    end;

    Result := xIF(nRet = 1,True, False);
end;

procedure TFormSMSSuremCall.CheckBoxShowClick(Sender: TObject);
begin
    PasswordShow;
end;

procedure TFormSMSSuremCall.SpeedButtonLoginClick(Sender: TObject);
begin
    LogInProgress(True);
end;

procedure TFormSMSSuremCall.SpeedButtonHelpClick(Sender: TObject);
{ 도움말 }
begin
    xHelp('u_cow122');
end;

procedure TFormSMSSuremCall.SpeedButtonMessageClick(Sender: TObject);
{ 이모티콘등록 }
begin
    with TFormSLSMSMessage.Create(Application) do begin
         ShowModal;
         Free;
    end;
end;

procedure TFormSMSSuremCall.SpeedButtonCashReferClick(Sender: TObject);
{ 사이버캐쉬조회 }
begin
    ShowCash;

    xMsg('사용 가능한 금액 : '+LabelCost.Caption+#13+#13+
         '건당 금액 : '+LabelDanga.Caption+#13+#13+
         '사용 가능한 횟수 : '+LabelCount.Caption);
end;

procedure TFormSMSSuremCall.SpeedButtonSystemClick(Sender: TObject);
{ 레지스터등록 }
var Registry: TRegistry;
    S: string;
begin
    Registry:=TRegistry.Create;
    Registry.RootKey := HKEY_CLASSES_ROOT;
    Registry.OpenKey('SMSCALL.SMSCALLMSG',False);
    S := Registry.ReadString('');
    Registry.Free;

    if Length( Trim(s) ) > 10 then begin
       if MessageDlg('SMSCall.DLL - 레지스터에 이미 등록되어있습니다.'+#13+#13+
                     '클라스가 등록되어있지 않습니다. 라는 오류가 나타난 경우라면'+#13+
                     '[ 예/Yes ]를 선택하여 등록작업을 다시 하십시오.'+#13+
                     '클라스와 관련된 오류가 아니라면 이 작업을 다시 할 필요가'+#13+
                     '없으며 고객지원실로 문의바랍니다.'+#13+#13+
                     '위의 내용을 무시하고 레지스터 등록작업을 다시 하시겠습니까 ?'
                     ,mtConfirmation, [mbYes,mbNo], 0) = mrYes then begin
          xRegister(ExtractFilePath(ParamStr(0))+'SMSCall.DLL');
       end;
    end;
end;

procedure TFormSMSSuremCall.SpeedButtonCloseClick(Sender: TObject);
{ 작업종료 }
begin
    SaveInformation;

    Close;
end;

procedure TFormSMSSuremCall.ImageMessageLoadClick(Sender: TObject);
begin
    with TFormSLSMSMsgItem.Create(Self) do begin
         if ShowModal = mrOK then MEMOMessage.Text := rMessage;
         Free;
    end;
end;

procedure TFormSMSSuremCall.ImageMessageSaveClick(Sender: TObject);
begin
    if xEmpty(MemoMessage.Text) then begin
       xMsg('메세지창에 내용이 비워있으므로 저장이 안됩니다.');

       Exit;
    end;

    OpenTable_SLSMS(ApolloDataSetSLSMS,True);

    with ApolloDataSetSLSMS do begin
         Append;
         FieldByName('SMSGRP').AsString := '';
         FieldByName('SMSMSG').AsString := xMemo2String(MemoMessage,0);
         FieldByName('SMSMEM').AsString := MemoMessage.Text;
         Commit;
    end;

    with ApolloDataSetSLSMS do begin
         Close;
    end;

    xMsg('저장이 완료되었습니다.');
end;

procedure TFormSMSSuremCall.ImageSendCancelClick(Sender: TObject);
{ 전송취소 }
begin
    MEMOMessage.Text := '';

    xEditTo.Text := '';
end;

procedure TFormSMSSuremCall.ImageSendOKClick(Sender: TObject);
{ 문자전송 }
begin
    ImageSendOK.Cursor  := crHourGlass;
    ImageSendOK.Enabled := False;

    //-- 로그인이 안되어있으면 로그인 먼저하고
    if g_DeptName <> 'swmake' then
       begin
           if LogInProgress(False) then SendMessage;
       end
    else SendMessage;

    ImageSendOK.Enabled := True;
    ImageSendOK.Cursor  := crHandPoint;
end;

procedure TFormSMSSuremCall.MemoMessageChange(Sender: TObject);
var sMemo : string;
    nSize : integer;
begin
    sMemo := Trim(MemoMessage.Text);

    //-- 메모장을 문자열로 전환하여 길이를 계산한다
    nSize := Length(xMemo2String(MemoMessage,16));

    if nSize > 80 then LabelMessage.Font.Color := clRed
                  else LabelMessage.Font.Color := clBlack;

    LabelMessage.Caption := IntToStr(nSize)+' / 80';
end;

procedure TFormSMSSuremCall.SpeedButtonJoinClick(Sender: TObject);
{ 회원가입 }
var html : string;
begin
    html := 'http://smscorp.surem.com/client/softmake/regist.asp';

    ShellExecute(Application.Handle,'open',pChar(html), nil,nil,SW_SHOW)
end;

procedure TFormSMSSuremCall.SpeedButtonPayMentClick(Sender: TObject);
{ 충전 }
var html : string;
begin
    html := 'http://smscorp.surem.com/client/softmake/cash.asp?usercode='+g_UserCode;

    ShellExecute(Application.Handle,'open',pChar(html), nil,nil,SW_SHOW)
end;

procedure TFormSMSSuremCall.SpeedButtonResultClick(Sender: TObject);
{ 전송결과조회 }
var html : string;
begin
    html := 'http://smscorp.surem.com/client/softmake/result.asp?usercode='+g_UserCode;

    ShellExecute(Application.Handle,'open',pChar(html), nil,nil,SW_SHOW)
end;

end.

============================================================================

function xPADC(pStr:string;pLength:integer):string;
{ xPADC('1234',10) = 'bbb1234bbb' }
var rem : integer;
begin
    rem := ( pLength - length(pStr) ) div 2;
    Result := xSpace(rem)+pStr+xSpace(rem);
end;
 
function xPADR(pStr:string;pLength:integer;pChar:Char):string;
{ xPADR('1234',6,'0') = '123400' }
var tStr  : string;
    tChar : char;
begin
    tStr  := pStr;
    if pChar = '' then tChar := ' '
                  else tChar := pChar;

    if length(tStr) > pLength then
       Result := copy(tStr,1,pLength)
    else begin
       while true do
       begin
         if length(tStr) < pLength then tStr := tStr + tChar
                                   else break;
       end;
       Result := tStr;
    end;
end;

function xPADL(pStr:string;pLength:integer;pChar:Char):string;
{ xPADL('1234',6,'0') = '001234' }
var tStr  : string;
    tChar : char;
    rChar : string;
begin
    tStr := pStr;
    if pChar = '' then tChar := ' '
                  else tChar := pChar;

    if length(tStr) > pLength then
       Result := copy(tStr,1,pLength)
    else begin
       rChar := '';
       while true do
       begin
         if length(tStr) < pLength then tStr := tChar + tStr
                                   else break;
       end;
       Result := tStr;
    end;
end;

function xSpace(pLen:Integer):String;
{ xSpace(4) = '   ' }
var inc : integer;
    ret : String;
begin
    ret := '';
    for inc := 1 to pLen do ret := ret + ' ';
    Result := ret;
end;

========================================================================================

 

function xString2Memo(pStr:string;pLength:integer):string;
{ xString2Memo('...') = '...'
            문자열을 받아서 메모장에 들어가게 변경한다.
                   한글때문에 적당한 위치에서 라인이 넘어가게 }
var tStr   : string;
    tRet   : string;
    tRem   : string;
    inc    : integer;
    Cnt    : integer;
begin
    tStr   := '';
    tRem   := pStr;
    tRet   := '';

    while True do begin
          //- 처리할 문자가 없거나 실수로 길이 파라미터를 1보다
          //-- 작게 넘겼다면 오류이므로 종료한다
          if xEmpty(tRem) or ( pLength < 1 ) then Break;

          if Length(tRem) < pLength then begin
             tRet := tRet + tRem;

             Break;
          end;

         //-- 지정된 길이만큼 잘라서
          tStr := COPY(tRem,1,pLength);  

          //-- 문자열에서 아스키값이 122(z)보다 큰게 몇개인지
          //-- 카운트해서 홀수개인 경우는 한글이 짤린경우이므로
          //-- 지정된 길이에서 앞글자 까지만 자르도록 한다.
          cnt := 0;
          for inc := 1 to length(tStr) do begin
              if ord(tStr[inc]) > 122 then cnt := cnt + 1;
          end;

          //-- 마지막글자의 아스키값이 122(z)보다 크면
         //-- 한글이 반 짤린것이므로
          //-- 앞의 글자까지만 짜르고 줄을 넘긴다
          if cnt mod 2 = 0 then
             begin
                 tRet := tRet + tStr;            //-- 메모장에 붙이고
                 tRet := tRet + #13 + #10;       //-- 라인을 넘기고
                //-- 나머지를 저장하고
                 tRem := COPY(tRem,pLength+1,Length(tRem)-pLength); 
             end
          else
             begin
                 tStr := COPY(tRem,1,pLength-1);
                 //-- 지정된 길이에서 앞글자까지만 잘라서

                 tRet := tRet + tStr;            //--  메모장에 붙이고
                 tRet := tRet + #13 + #10;       //-- 라인을 넘기고
                 tRem := COPY(tRem,pLength,Length(tRem)-pLength+1);  //-- 나머지를 저장하고
             end;
    end;

    Result := tRet;
end;