ab.com コミュニティ

/*****************************/
/* 住所録データ管理          */
/* Version V48.01 2006.06.03 */
/*****************************/
#N88BASIC
'AB4/AB5に標準定義されていないAPI
  DECLARE FUNCTION lstcpyn LIB "kernel32" ALIAS "lstrcpynA" (I1 AS LPSTR,I2 AS LPSTR,I3 AS LONG)
/********************/
/* コンスタント定義 */
/********************/
  CONST NL=&H00
  CONST CR=&H0D
  CONST LF=&H0A
  CONST SP=&H20
  CONST CRLF=EX"\r\n"
  CONST RECL   = 112
  CONST NAMEKL = 16
  CONST NAMENL = 16
  CONST MAILL  = 10
  CONST ADDRL  = 56
  CONST TELL   = 12
  CONST NAMEKP = 0
  CONST NAMENP = NAMEKL
  CONST MAILP  = NAMENP + NAMENL
  CONST ADDRP  = MAILP  + MAILL
  CONST TELP   = ADDRP  + ADDRL
  CONST MAXCNT = 25
  CONST NXTCNT = 14
  CONST DSPMSL = "氏名カナ        氏名            郵便番号  住所"
  CONST SPCDSP = "                                                    "
  CONST DSPMSR = "電話番号"
  CONST LSTMSG = "  番号 氏名カナ       　氏名"
  CONST SPCLST = "            "
  DIM ERROR AS LONG,HFILE AS LONG
  DIM DWFILESIZE AS DWORD,DWACCESSBYTE AS DWORD
  DIM BUFWKP AS *BYTE,MSGP AS *BYTE
  TYPEDEF STRING = String
  TYPE COMR
    N       AS LONG
    CUR     AS LONG
    CURP    AS *BYTE
    MSG     AS STRING
    NO      AS STRING
    SNO     AS STRING
    KEY     AS STRING
    DSP     AS STRING
    LST     AS STRING
    TEXT    AS STRING
    FNAME   AS STRING
    WFNAME  AS STRING
    NAMEK   AS STRING
    NAMEN   AS STRING
    MAIL    AS STRING
    ADDR    AS STRING
    TEL     AS STRING
    RENEW   AS BYTE
    SW      AS BYTE
    BUFP    AS *BYTE
  END TYPE
  DIM COM AS COMR
  COM.BUFP  = NULL
  COM.MSG   = ZeroString(RECL * 4)
  COM.DSP   = ZeroString(RECL + 16)
  COM.LST   = ZeroString(RECL + 16)
  COM.NAMEK = ZeroString(NAMEKL + 1)
  COM.NAMEN = ZeroString(NAMENL + 1)
  COM.MAIL  = ZeroString(MAILL  + 1)
  COM.ADDR  = ZeroString(ADDRL  + 1)
  COM.TEL   = ZeroString(TELL   + 1)
  CLS 3
  LINE(0000,0000)-(1018,0000),4
  LINE(0000,0000)-(0000,0706),4
  LINE(1018,0000)-(1018,0706),4
  LINE(0000,0706)-(1018,0706),4
  LOCATE 1,1
  PRINT "TEST開始(Version 48.01)(SINCE 1985-2001 OS-9 LEVLE2,2004 WINDOWS XP)"
  LOCATE 1,2
  PRINT "TEST只今、初期設定中です。しばらくお待ち下さい。"
  Sleep(1500)
  COM.WFNAME = "TEST.TXT"
  COM.FNAME = COM.WFNAME
  TESTAGET()
  IF ERROR > 0 THEN
    TESTAINP(0)
  ELSE
  ENDIF
  TESTACNL()
  IF COM.RENEW = TRUE THEN
    DO
      LOCATE 1,15
      PRINT "ファイルを更新しますか？（Ｙ／Ｎ）"
      COM.NO = Input$(1)
    LOOP UNTIL COM.NO = "Y" OR COM.NO = "N"
    IF COM.NO = "Y" THEN
      TESTAPUT()
    ELSE
    END IF
  ELSE
  END IF
  CLS 3
  LINE(0000,0000)-(1018,0000),4
  LINE(0000,0000)-(0000,0706),4
  LINE(1018,0000)-(1018,0706),4
  LINE(0000,0706)-(1018,0706),4
  LOCATE 1,_PromptSys_CurPos.y + 1
  PRINT "TEST終了"
  Sleep(4000)
/******************/
/* メイン制御処理 */
/******************/
SUB TESTACNL()
  DO
    CLS 3
    LINE(0000,0000)-(1018,0000),4
    LINE(0000,0000)-(0000,0706),4
    LINE(1018,0000)-(1018,0706),4
    LINE(0000,0706)-(1018,0706),4
    LOCATE 1,1
    PRINT "＊＊＊＊＊　ＰＩＡＳ処理メニュー　＊＊＊＊＊"
    LOCATE 1,3
    PRINT "１：住所録データを編集する"
    LOCATE 1,4
    PRINT "２：住所録データを並べ替える"
    LOCATE 1,5
    PRINT "３：住所録データを表示する"
    LOCATE 1,6
    PRINT "４：住所録データをＣＳＶに変換する"
    LOCATE 1,7
    PRINT "５：ＣＳＶを住所録データに変換する"
    LOCATE 1,8
    PRINT "Ｒ：新たにファイルを読込む"
    LOCATE 1,9
    PRINT "Ｗ：ファイルを更新する"
    LOCATE 1,10
    PRINT "Ｘ：終了"
    DO
      LOCATE 1,12
      PRINT "TEST:";
      INPUT "",COM.NO
      SELECT CASE COM.NO
        CASE "1"
          TESTEDT(COM)
        CASE "2"
          TESTSRT(COM)
        CASE "3"
          TESTDSP(COM)
        CASE "4"
          TESTPCS(COM)
        CASE "5"
          TESTPTX(COM)
        CASE "R","r"
          TESTAINP(1)
        CASE "W","w"
          TESTAPUT()
          TESTAGET()
        CASE "X","x"
          EXIT DO
        CASE ELSE
          LOCATE 1,13
          COLOR 2
          PRINT "処理番号に誤りがあります。"
          LOCATE 1,14
          COLOR 6
          PRINT "１～５、Ｒ、Ｗ、Ｘいずれかを指定して下さい。"
          COLOR 7
      END SELECT
    LOOP UNTIL COM.NO >= "1" AND COM.NO <= "5" OR _
               COM.NO  = "R" OR  COM.NO  = "r" OR COM.NO  = "W" OR  COM.NO  = "w"
  LOOP UNTIL COM.NO = "X" OR COM.NO = "x"
END SUB
/******************/
/* ファイル名入力 */
/******************/
SUB TESTAINP(PARA AS LONG)
  CLS 3
  LINE(0000,0000)-(1018,0000),4
  LINE(0000,0000)-(0000,0706),4
  LINE(1018,0000)-(1018,0706),4
  LINE(0000,0706)-(1018,0706),4
  LOCATE 1,1
  PRINT "***** ファイル情報 *****"
  LOCATE 1,3
  PRINT "ファイル名：";COM.FNAME
  LOCATE 1,4
  PRINT "データ数　：";COM.N
  IF ERROR > 0 AND PARA = 0 THEN
    COLOR 2
    LOCATE 1,9
    PRINT SPCDSP + SPCDSP
    LOCATE 1,9
    PRINT COM.MSG
    COLOR 7
  ELSE
  END IF
  DO
    LOCATE 1,6
    PRINT "ファイル名を指定してください。"
    LOCATE 1,7
    INPUT "",COM.WFNAME
    IF COM.WFNAME = "" OR COM.WFNAME = "X" OR COM.WFNAME = "x" THEN
      EXIT DO
    ELSE
      COM.WFNAME = COM.WFNAME + ".TXT"
    END IF
    TESTAGET()
    IF ERROR = 0 THEN
      COM.FNAME = COM.WFNAME
      EXIT DO
    ELSE
      COLOR 2
      LOCATE 1,9
      PRINT SPCDSP + SPCDSP
      LOCATE 1,9
      PRINT COM.MSG
      COLOR 7
    ENDIF
  LOOP
END SUB
/******************/
/* データ読み込み */
/******************/
SUB TESTAGET()
  ERROR = 0
  HFILE = CreateFile(COM.WFNAME,GENERIC_READ,FILE_SHARE_READ,
                     ByVal 0,OPEN_EXISTING,FILE_ATTRIBUTE_NORMAL,0)
  IF HFILE <> INVALID_HANDLE_VALUE THEN 
    DWFILESIZE = GetFileSize(HFILE,0)
    COM.BUFP   = calloc(DWFILESIZE+1)
    ReadFile(HFILE,COM.BUFP,DWFILESIZE,VarPtr(DWACCESSBYTE),ByVal 0)
    COM.BUFP[DWACCESSBYTE] = 0
    COM.N = DWACCESSBYTE / RECL
    CloseHandle(HFILE)
  ELSE
    ERROR = GetLastError()
    FormatMessage(FORMAT_MESSAGE_ALLOCATE_BUFFER OR _
                  FORMAT_MESSAGE_FROM_SYSTEM     OR _
                  FORMAT_MESSAGE_IGNORE_INSERTS,
                  NULL,
                  ERROR,
                  LANG_USER_DEFAULT,
                  VarPtr(MSGP),
                  0,
                  NULL)
    wsprintf(COM.MSG,"%s%04d%s","ERROR ",ERROR,"：")
    IF MSGP = NULL THEN
      lstrcat(COM.MSG,"該当エラーメッセージ未定義。")
    ELSE
      lstrcat(COM.MSG,MSGP)
      LocalFree(MSGP)
    END IF
  END IF
  COM.RENEW = FALSE
  COM.CUR   = 0
  COM.CURP  = COM.BUFP
END SUB
/******************/
/* データ書き込み */
/******************/
SUB TESTAPUT()
  LOCATE 1,_PromptSys_CurPos.y + 1
  PRINT "ファイルの更新を開始します。"
  HFILE = CreateFile(COM.FNAME,GENERIC_WRITE,0,ByVal 0,
                     CREATE_ALWAYS,FILE_ATTRIBUTE_NORMAL,0)
  WriteFile(HFILE,COM.BUFP,DWFILESIZE,VarPtr(DWACCESSBYTE),ByVal 0)
  CloseHandle(HFILE)
  LOCATE 1,_PromptSys_CurPos.y
  PRINT "ファイルの更新を終了します。更新件数";COM.N
  Input$(1)
  free(COM.BUFP)
  COM.BUFP = NULL
END SUB
/********************/
/* 住所録データ表示 */
/********************/
SUB TESTDSP(BYREF PR AS COMR)
  DO
    CLS 3
    LINE(0000,0000)-(1018,0000),4
    LINE(0000,0000)-(0000,0706),4
    LINE(1018,0000)-(1018,0706),4
    LINE(0000,0706)-(1018,0706),4
    LOCATE 1,1
    PRINT "***** 住所録表示メニュー *****"
    LOCATE 1,3
    PRINT "１：全データ表示"
    LOCATE 1,4
    PRINT "２：対象データ表示"
    LOCATE 1,5
    PRINT "３：ファイル情報表示"
    LOCATE 1,6
    PRINT "Ｘ：終了"
    DO
      LOCATE 1,8
      INPUT "DISP:",PR.SNO
      SELECT CASE PR.SNO
        CASE "1"
          TESTDSPA(PR)
        CASE "2"
          TESTDSPF(PR)
        CASE "3"
          TESTDSPI(PR)
        CASE "X","x"
          EXIT DO
        CASE ELSE
          LOCATE 1,9
          PRINT "処理番号に誤りがあります。"
      END SELECT
    LOOP UNTIL PR.SNO >= "1" AND PR.SNO <= "3"
  LOOP UNTIL PR.SNO = "X" OR PR.SNO = "x"
END SUB
/****************/
/* 全データ表示 */
/****************/
SUB TESTDSPA(BYREF PR AS COMR)
  DIM COUNT AS LONG,I AS LONG
  DIM BUFWKP AS *BYTE
  BUFWKP = PR.BUFP
  COUNT = 0
  FOR I = 0 TO PR.N - 1
    IF COUNT = MAXCNT THEN
      LOCATE 0,28
      PRINT "どれかのキーを押して下さい。"
      Input$(1)
      COUNT = 0
    ELSE
    END IF
    IF COUNT = 0 THEN
      CLS 3
      PRINT DSPMSL + SPCDSP + DSPMSR
      PRINT
    ELSE
    END IF
    IF BUFWKP(0) = SP THEN
      PRINT "空きデータです。"
    ELSE 
      memcpy(StrPtr(PR.DSP),BUFWKP,RECL)
      PRINT PR.DSP
    END IF
    COUNT = COUNT + 1
    BUFWKP = BUFWKP + RECL
  NEXT I
  LOCATE 0,28
  PRINT "どれかのキーを押して下さい。"
  Input$(1)
END SUB
/******************/
/* 対象データ表示 */
/******************/
SUB TESTDSPF(BYREF PR AS COMR)
  CLS 3
  DO
    LOCATE 0,_PromptSys_CurPos.y   
    PRINT "検索対象データを入力して下さい（X:終了、? OR ENTER：リスト表示）"
    INPUT "DISP:",PR.KEY
    SELECT CASE PR.KEY
      CASE "X","x"
        EXIT DO
      CASE "?"
        TESTLST(PR)
      CASE ""
        TESTLST(PR)
      CASE ELSE
        TESTDSPD(PR)
    END SELECT
  LOOP
END SUB
/**************/
/* データ表示 */
/**************/
SUB TESTDSPD(BYREF PR AS COMR)
  DIM COUNT AS LONG,HIT AS LONG,I AS LONG
  DIM BUFWKP AS *BYTE
  BUFWKP = PR.BUFP
  COUNT = 0
  HIT = 0
  PR.SW = FALSE
  FOR I = 0 TO PR.N - 1
    lstcpyn(PR.DSP,BUFWKP,RECL + 1)
    IF SUBSTR(PR.DSP,PR.KEY) > 0 THEN
      PR.SW = TRUE
      IF COUNT = MAXCNT THEN
        LOCATE 0,28
        PRINT "どれかのキーを押して下さい。"
        Input$(1)
        COUNT = 0
      ELSE
      END IF
      IF COUNT = 0 THEN
        CLS 3
        PRINT DSPMSL + SPCDSP + DSPMSR
        PRINT
      ELSE
      END IF
      IF BUFWKP(0) = SP THEN
        PRINT "空きデータです。"
      ELSE 
        memcpy(StrPtr(PR.DSP),BUFWKP,RECL)
        PRINT PR.DSP
      END IF
      COUNT = COUNT + 1
      HIT = HIT + 1
    ELSE
    ENDIF
    BUFWKP = BUFWKP + RECL
  NEXT
  IF PR.SW = TRUE THEN
    LOCATE 0,28
    PRINT "どれかのキーを押して下さい（";HIT;"件ヒットしました）。"
    Input$(1)
    CLS 3
  ELSE
    LOCATE 0,_PromptSys_CurPos.y
    COLOR 6
    PRINT "該当データなし"
    COLOR 7
  END IF
END SUB
/********************/
/* ファイル情報表示 */
/********************/
SUB TESTDSPI(BYREF PR AS COMR)
  DIM EMP AS LONG,I AS LONG,USE AS LONG
  DIM BUFWKP AS *BYTE
  BUFWKP = PR.BUFP
  EMP = 0
  USE = 0
  FOR I = 0 TO PR.N - 1
    IF BUFWKP(0) = SP THEN
      EMP = EMP + 1
    ELSE 
      USE = USE + 1
    END IF
    BUFWKP = BUFWKP + RECL
  NEXT I
  CLS 3
  LINE(0000,0000)-(1018,0000),4
  LINE(0000,0000)-(0000,0706),4
  LINE(1018,0000)-(1018,0706),4
  LINE(0000,0706)-(1018,0706),4
  LOCATE 1,1
  PRINT "***** ファイル情報 *****"
  LOCATE 1,3
  PRINT "ファイル名：";PR.FNAME
  LOCATE 1,4
  PRINT "データ数　：";PR.N
  LOCATE 1,5
  PRINT "使用中件数：";USE
  LOCATE 1,6
  PRINT "未使用件数：";EMP
  LOCATE 1,28
  PRINT "どれかのキーを押して下さい。"
  Input$(1)
END SUB
/********************/
/* 住所録データ編集 */
/********************/
SUB TESTEDT(BYREF PR AS COMR)
  CLS 3
  DO   
    PRINT "編集対象を入力して下さい（X:終了、?:索引表示、";
    PRINT "データ件数";PR.N;"、";"現在位置";PR.CUR + 1;"）"
    INPUT "EDIT:",PR.KEY
    SELECT CASE PR.KEY
      CASE "X","x"
        EXIT DO
      CASE "?"
        TESTLST(COM)
      CASE ELSE
        TESTEDTF(COM)
        IF PR.SW = TRUE THEN
          memcpy(StrPtr(PR.NAMEK),PR.CURP + NAMEKP,NAMEKL)
          memcpy(StrPtr(PR.NAMEN),PR.CURP + NAMENP,NAMENL)
          memcpy(StrPtr(PR.MAIL),PR.CURP + MAILP,MAILL)
          memcpy(StrPtr(PR.ADDR),PR.CURP + ADDRP,ADDRL)
          memcpy(StrPtr(PR.TEL),PR.CURP + TELP,TELL)
          TESTEDTP(COM)
          TESTEDTE(COM)
          CLS 3 
        ELSE
          COLOR 6
          PRINT "該当データは存在しません。"
          PRINT
          COLOR 7
        END IF
    END SELECT
  LOOP
END SUB
/******************/
/* データ検索処理 */
/******************/
SUB TESTEDTF(BYREF PR AS COMR)
  DIM POS AS LONG
  IF PR.KEY = "" THEN
    PR.SW = TRUE
  ELSE
    IF NUMCHK(PR.KEY) = TRUE THEN
      POS = Val(PR.KEY) - 1
      IF POS >= 0 AND POS <= PR.N - 1 THEN
        PR.CUR  = POS
        PR.CURP = PR.BUFP + POS * RECL
        PR.SW   = TRUE
      ELSE
        PR.SW   = FALSE
      END IF
    ELSE
      POS = SUBSTR(PR.BUFP,PR.KEY)
      IF POS > 0 THEN
        PR.SW   = TRUE
        PR.CUR  = POS / RECL
        PR.CURP = PR.BUFP + PR.CUR * RECL
      ELSE
        PR.SW   = FALSE
      ENDIF
    END IF
  END IF
END SUB
/******************/
/* データ編集処理 */
/******************/
SUB TESTEDTE(BYREF PR AS COMR)
  DIM ARG(5) AS LONG,ARGC AS LONG,I AS LONG
  DO
    DO
      LOCATE 1,11
      PRINT "処理を指示して下さい。１：登録、２：修正、３：削除、Ｗ：更新終了、Ｘ：終了"
      PR.SNO = Input$(1)
    LOOP UNTIL PR.SNO >= "1" AND PR.SNO <= "3" OR PR.SNO = "W" OR PR.SNO = "X"
    SELECT CASE PR.SNO
      CASE "1"
        FOR I = 1 TO 5
          TESTEDTQ(COM,I)
        NEXT
      CASE "2"
        LOCATE 1,12
        PRINT "修正項目→１：氏名カナ、２：氏名漢字、３：郵便番号、４：住所、５：電話番号"
        LOCATE 1,13
        INPUT "",PR.TEXT
        ARGC = 0
        FOR I = 0 TO Len(PR.TEXT) - 1
          ARG(ARGC) = PR.TEXT(I)
          IF ARG(ARGC) = SP THEN
            CONTINUE
          ELSE         
            ARG(ARGC) = ARG(ARGC) - &H30
            ARGC      = ARGC + 1
          END IF
        NEXT
        FOR I = 0 TO ARGC - 1
          TESTEDTQ(COM,ARG(I))
        NEXT
      CASE "3"
        FillMemory(StrPtr(PR.NAMEK),NAMEKL,SP)
        FillMemory(StrPtr(PR.NAMEN),NAMENL,SP)
        FillMemory(StrPtr(PR.MAIL),MAILL,SP)
        FillMemory(StrPtr(PR.ADDR),ADDRL,SP)
        FillMemory(StrPtr(PR.TEL),TELL,SP)
      CASE "W"
        FillMemory(PR.CURP,RECL - 2,SP)
        memcpy(PR.CURP + NAMEKP,StrPtr(PR.NAMEK),Len(PR.NAMEK))
        memcpy(PR.CURP + NAMENP,StrPtr(PR.NAMEN),Len(PR.NAMEN))
        memcpy(PR.CURP + MAILP ,StrPtr(PR.MAIL),Len(PR.MAIL))
        memcpy(PR.CURP + ADDRP ,StrPtr(PR.ADDR),Len(PR.ADDR))
        memcpy(PR.CURP + TELP  ,StrPtr(PR.TEL),Len(PR.TEL))
        memcpy(PR.CURP + RECL - 2,CRLF,2)
        PR.RENEW  = TRUE
        EXIT DO
      CASE "X"
        EXIT DO
      CASE ELSE
        CONTINUE
    END SELECT
    TESTEDTP(COM)
  LOOP
END SUB
/******************/
/* データ表示処理 */
/******************/
SUB TESTEDTP(BYREF PR AS COMR)
  CLS 3
  LOCATE 1,0
  PRINT "氏名カナ：";PR.NAMEK
  LOCATE 1,2
  PRINT "氏名漢字：";PR.NAMEN
  LOCATE 1,4
  PRINT "郵便番号：";PR.MAIL
  LOCATE 1,6
  PRINT "住　　所：";PR.ADDR
  LOCATE 1,8
  PRINT "電話番号：";PR.TEL
  LOCATE 1,10
END SUB
/******************/
/* データ入力処理 */
/******************/
SUB TESTEDTQ(BYREF PR AS COMR,POS AS LONG)
  SELECT CASE POS
    CASE 1
      LOCATE 12,0
      INPUT "",PR.TEXT
      TESTTRN(NAMEKP,PR.TEXT,PR.NAMEK,NAMEKL,Len(PR.TEXT))
    CASE 2
      LOCATE 12,2
      INPUT "",PR.TEXT
      TESTTRN(NAMENL,PR.TEXT,PR.NAMEN,NAMENL,Len(PR.TEXT))
    CASE 3
      LOCATE 12,4
      INPUT "",PR.TEXT
      TESTTRN(MAILP,PR.TEXT,PR.MAIL,MAILL,Len(PR.TEXT))
    CASE 4  
      LOCATE 12,6
      INPUT "",PR.TEXT
      TESTTRN(ADDRP,PR.TEXT,PR.ADDR,ADDRL,Len(PR.TEXT))
    CASE 5
      LOCATE 12,8
      INPUT "",PR.TEXT
      TESTTRN(TELP,PR.TEXT,PR.TEL,TELL,Len(PR.TEXT))
    CASE ELSE
      EXIT SUB
  END SELECT
END SUB
/********************/
/* 住所録リスト表示 */
/********************/
SUB TESTLST(BYREF PR AS COMR)
  DIM COUNT AS LONG,I AS LONG,P AS LONG
  DIM FLAG AS BYTE,WORK2[20] AS BYTE,WORK3[20] AS BYTE
  DIM BUFWKP AS *BYTE
  COUNT = 0
  BUFWKP = PR.BUFP
  CLS 3
  PRINT LSTMSG + SPCLST + LSTMSG
  PRINT
  FOR I = 0 TO PR.N - 1
    IF COUNT < MAXCNT + 1 THEN
      COUNT = COUNT + 1
    ELSE
      DO 
        LOCATE 0,17
        PRINT "処理を指示して下さい。Ｙ：継続、Ｘ：終了"
        SELECT CASE Input$(1)
          CASE "X"
            EXIT FOR
          CASE "Y"
            COUNT = 1
            CLS 3
            PRINT LSTMSG + SPCLST + LSTMSG
            PRINT
            EXIT DO
          CASE ELSE
            CONTINUE
        END SELECT
      LOOP
    END IF
    IF COUNT < NXTCNT THEN
      LOCATE  0,COUNT + 1
    ELSE
      LOCATE 40,COUNT + 2 - NXTCNT
    END IF
    IF I = PR.CUR THEN
      FLAG = &H2A
    ELSE
      FLAG = &H20
    END IF
    P = I + 1
    IF BUFWKP(0) = SP THEN
      wsprintf(COM.LST,"%c%5d%s",FLAG,P," 空きデータです。                 "+CRLF)
    ELSE
      memcpy(WORK2,BUFWKP,16)
      memcpy(WORK3,BUFWKP + 16,16)
      wsprintf(COM.LST,"%c%5d%s%s%s%s",FLAG,P," ",WORK2," ",WORK3)
    END IF
    PRINT COM.LST
    BUFWKP = BUFWKP + RECL
  NEXT
  LOCATE 0,17
  PRINT "表示終了しました。どれかのキーを押してください。"
  Input$(1)
END SUB
/**************************/
/* 住所録データＣＳＶ変換 */
/**************************/
SUB TESTPCS(BYREF PR AS COMR)
  DIM HFILE AS LONG,I AS LONG
  DIM DWACCESSBYTE AS DWORD
  DIM CSV[127] AS BYTE,CSVWK[60] AS BYTE
  DIM CSVWKP AS *BYTE,BUFWKP AS *BYTE
  CLS 3
  LINE(0000,0000)-(1018,0000),4
  LINE(0000,0000)-(0000,0706),4
  LINE(1018,0000)-(1018,0706),4
  LINE(0000,0706)-(1018,0706),4
  LOCATE 1,1
  PRINT "***** ＣＳＶ形式変換処理開始 *****";Date$();Time$()
  HFILE = CreateFile("TEST.CSV",GENERIC_WRITE,0,ByVal 0,
                     CREATE_ALWAYS,FILE_ATTRIBUTE_NORMAL,0)
  BUFWKP = COM.BUFP
  FOR I = 0 TO PR.N - 1
    ZeroMemory(CSV,Len(CSV))
    ZeroMemory(CSVWK,Len(CSVWK))
    memcpy(CSVWK,BUFWKP + NAMEKP,NAMEKL) '氏名カナ
    TRIM(CSVWK)
    lstrcat(CSV,CSVWK)
    lstrcat(CSV,",")
    ZeroMemory(CSVWK,Len(CSVWK))
    memcpy(CSVWK,BUFWKP + NAMENP,NAMENL) '氏名漢字
    TRIM(CSVWK)
    lstrcat(CSV,CSVWK)
    lstrcat(CSV,",")
    ZeroMemory(CSVWK,Len(CSVWK))
    memcpy(CSVWK,BUFWKP + MAILP,MAILL) '郵便番号
    TRIM(CSVWK)
    lstrcat(CSV,CSVWK)
    lstrcat(CSV,",")
    ZeroMemory(CSVWK,Len(CSVWK))
    memcpy(CSVWK,BUFWKP + ADDRP,ADDRL) '住所
    TRIM(CSVWK)
    lstrcat(CSV,CSVWK)
    lstrcat(CSV,",")
    ZeroMemory(CSVWK,Len(CSVWK))
    memcpy(CSVWK,BUFWKP + TELP,TELL) '電話番号
    TRIM(CSVWK)
    lstrcat(CSV,CSVWK)
    lstrcat(CSV,CRLF)
    WriteFile(HFILE,CSV,lstrlen(CSV),VarPtr(DWACCESSBYTE),ByVal 0)
    BUFWKP = BUFWKP + RECL
  NEXT
  CloseHandle(HFILE)
  LOCATE 1,2
  PRINT "ＣＳＶ変換処理件数：";PR.N
  LOCATE 1,3
  PRINT "***** ＣＳＶ形式変換処理終了 *****";Date$();Time$()
  LOCATE 1,28
  PRINT "どれかのキーを押して下さい。"
  Input$(1)
END SUB
/****************************/
/* 住所録データＴＥＸＴ変換 */
/****************************/
SUB TESTPTX(BYREF PR AS COMR)
  DIM HFILE AS LONG,I AS LONG,J AS LONG,K AS LONG,L AS LONG,N AS LONG,P AS LONG
  DIM BUF AS *BYTE,BUFWKP AS *BYTE,CSVP AS *BYTE
  DIM DWFILESIZE AS DWord,DWACCESSBYTE AS DWORD
  DIM CSV(127) AS BYTE,TEXT(112) AS BYTE
  CLS 3
  LINE(0000,0000)-(1018,0000),4
  LINE(0000,0000)-(0000,0706),4
  LINE(1018,0000)-(1018,0706),4
  LINE(0000,0706)-(1018,0706),4
  LOCATE 1,1
  PRINT "***** ＴＥＸＴ形式変換処理開始 *****";Date$();Time$()
  HFILE = CreateFile("TEST.CSV",GENERIC_READ,FILE_SHARE_READ,
                     ByVal 0,OPEN_EXISTING,FILE_ATTRIBUTE_NORMAL,0)
  DWFILESIZE = GetFileSize(HFILE,0)
  BUF    = calloc(DWFILESIZE+1)
  BUFWKP = BUF
  ReadFile(HFILE,BUF,DWFILESIZE,VarPtr(DWACCESSBYTE),ByVal 0)
  BUF[DWACCESSBYTE] = 0
  N = GETLINE(BUF,DWFILESIZE)
  CloseHandle(HFILE)
  HFILE = CreateFile("TESTCSV.TXT",GENERIC_WRITE,0,ByVal 0,
                     CREATE_ALWAYS,FILE_ATTRIBUTE_NORMAL,0)
  FOR I = 1 TO N
    L = ZSTRLEN(BUFWKP)
    FillMemory(TEXT,RECL,SP)
    lstcpyn(CSV,BUFWKP,L + 1)
    CSVP = CSV
    FOR J = 1 TO 5
      SELECT CASE J
        CASE 1
          P = NAMEKP
        CASE 2
          P = NAMENP
        CASE 3
          P = MAILP
        CASE 4
          P = ADDRP
        CASE ELSE
          P = TELP
      END SELECT
      K = SUBSTR(CSVP,",")
      IF K > 0 THEN
        memcpy(TEXT + P,CSVP,K - 1)
        CSVP = CSVP + K
      ELSE
        memcpy(TEXT + P,CSVP,lstrlen(CSVP) - 2)
        memcpy(TEXT + RECL - 2,CRLF,2)
        EXIT FOR
      END IF
    NEXT
    WriteFile(HFILE,TEXT,RECL,VarPtr(DWACCESSBYTE),ByVal 0)
    BUFWKP = BUFWKP + L
  NEXT
  CloseHandle(HFILE)
  free(BUF)
  LOCATE 1,2
  PRINT "ＴＥＸＴ変換処理件数：";N
  LOCATE 1,3
  PRINT "***** ＴＥＸＴ形式変換処理終了 *****";Date$();Time$()
  LOCATE 1,28
  PRINT "どれかのキーを押して下さい。"
  Input$(1)
END SUB
/************************/
/* 住所録データ並べ替え */
/************************/
SUB TESTSRT(BYREF PR AS COMR)
  DIM I AS LONG,J AS LONG,LNG AS LONG,POS AS LONG
  DO
    CLS 3
    LINE(0000,0000)-(1018,0000),4
    LINE(0000,0000)-(0000,0706),4
    LINE(1018,0000)-(1018,0706),4
    LINE(0000,0706)-(1018,0706),4
    LOCATE 1,1
    PRINT "***** 住所録並べ替えメニュー *****"
    LOCATE 1,3
    PRINT "１：氏名カナ順"
    LOCATE 1,4
    PRINT "２：郵便番号順"
    LOCATE 1,5
    PRINT "Ｘ：終了"
    DO
      LOCATE 1,7
      INPUT "SORT:",PR.SNO
      SELECT CASE PR.SNO
        CASE "1"
          POS = NAMEKP
          LNG = NAMEKL
          CSORT(PR.BUFP,PR.N,RECL,LNG,POS)
          PR.RENEW = TRUE
        CASE "2"
          POS = MAILP
          LNG = MAILL
          CSORT(PR.BUFP,PR.N,RECL,LNG,POS)
          PR.RENEW = TRUE
        CASE "X","x"
          EXIT DO
        CASE ELSE
          LOCATE 1,8
          PRINT "処理番号に誤りがあります。"
      END SELECT
    LOOP UNTIL PR.SNO = "1" OR PR.SNO = "2"
  LOOP UNTIL PR.SNO = "X" OR PR.SNO = "x"
END SUB
/********************/
/* 住所録データ転送 */
/********************/
SUB TESTTRN(ID AS LONG,ITX AS *BYTE,OTX AS *BYTE,N1 AS LONG,N2 AS LONG)
  DIM I AS LONG,L AS LONG
  DIM MOJI AS *BYTE,WRK(128) AS BYTE,WRK1(2) AS BYTE,WRK2(2) AS BYTE
  ZeroMemory(WRK,128)
  IF ID = NAMEKP OR ID = MAILP OR ID = TELP THEN
    MOJI = "@"
  ELSE
    MOJI = "＠"
  END IF
  L    = lstrlen(MOJI)
  FOR I = 1 TO N1 STEP L
    lstcpyn(WRK1,ITX + I - 1,L + 1)
    IF memcmp(WRK1,MOJI,L) = 0 OR Len(ITX) = 0 OR (N1 > N2 AND I > N2) THEN
      lstcpyn(WRK2,OTX + I - 1,L + 1)
    ELSE
      lstrcpy(WRK2,WRK1)
    ENDIF
    lstrcat(WRK,WRK2)
  NEXT
  memcpy(OTX,WRK,lstrlen(WRK))
END SUB
/************************/
/*ここから自作ライブラリ*/
/************************/
/**********************/
/* メモリソートを行う */
/**********************/
SUB CSORT(IO1BUF AS *BYTE,I2N AS LONG,I3RECL AS LONG,I4KEYL AS LONG,I5POS AS LONG)
  DIM I AS LONG,J AS LONG,K AS LONG
  DIM BUFI AS *BYTE,BUFJ AS *BYTE
  DIM WORK AS BYTE
  BUFI = IO1BUF
  FOR I = 0 TO I2N - 2
    BUFJ = BUFI + I3RECL
    FOR J = I + 1 TO I2N - 1
      IF CompareString(LOCALE_SYSTEM_DEFAULT,0,BUFI + I5POS,I4KEYL,BUFJ + I5POS,I4KEYL) = CSTR_GREATER_THAN THEN
        SWAP(BUFI,BUFJ,I3RECL)
      END IF
      BUFJ = BUFJ + I3RECL
    NEXT
    BUFI = BUFI + I3RECL
  NEXT
END SUB
/**************************/
/* テキストの行数を求める */
/**************************/
FUNCTION GETLINE(I1STRP AS *BYTE,I2LNG AS LONG) AS LONG
  DIM CNT AS LONG,I AS LONG
  CNT = 0
  I   = 0
  WHILE I < I2LNG
    IF I1STRP(I) = CR AND I1STRP(I + 1) = LF THEN
      CNT = CNT + 1
    ELSE
    END IF
    I = I + 1
  WEND
  GETLINE = CNT
END FUNCTION
/********************************/
/* １行の最大レコード長を求める */
/********************************/
FUNCTION GETTXTLN(I1STRP AS *BYTE,I2LNG AS LONG) AS LONG
  DIM I AS LONG,J AS LONG,TXTLN AS LONG
  I     = 0
  TXTLN = I
  WHILE I < I2LNG
    J      = ZSTRLEN(I1STRP)
    TXTLN  = MAX(TXTLN,J)
    I1STRP = I1STRP + J
    I      = I + 1
  WEND
  GETTXTLN = TXTLN
END FUNCTION
/******************************/
/* 指定行の位置と長さを求める */
/******************************/
SUB GETPOSSZ(I1STRP AS *BYTE,I2LINF AS LONG,I3LINN AS LONG,I4MAXSZ AS LONG,_
                    I5MAXLN AS LONG,ByRef O1POS AS LONG,ByRef O2SIZE AS LONG)
  DIM I AS LONG,WSIZE AS LONG
  DIM WPOS AS *BYTE,WSTR AS *BYTE
  DIM WPOS64 AS QWORD,WSTR64 AS QWORD
  IF I2LINF > I5MAXLN OR (I2LINF + I3LINN - 1) > I5MAXLN OR I3LINN > I5MAXLN THEN
    O1POS  = 0
    O2SIZE = 0
  ELSE
    O1POS = 1
    WPOS  = 1
    WSTR  = I1STRP
    FOR I = 1 TO I2LINF - 1
      DO
        IF WSTR(0) = CR AND WSTR(1) = LF THEN
          WSTR     = WSTR + 2
          O1POS    = WSTR - I1STRP + 1
          EXIT DO
        ELSE
          WSTR     = WSTR + 1
        ENDIF
      LOOP
    NEXT
    WPOS = WSTR
    I    = 0
    DO
      IF WSTR(0) = CR AND WSTR(1) = LF THEN
        I      = I    + 1
        WSTR   = WSTR + 2
        WPOS64 = WPOS
        WSTR64 = WSTR
        IF (WPOS64 - WSTR64) >= I4MAXSZ THEN
          O2SIZE = WSTR64 - WPOS64
          EXIT DO
        ELSE
          IF I >= I3LINN THEN
            O2SIZE = WSTR64 - WPOS64
            EXIT DO
          ELSE
          ENDIF
        ENDIF
      ELSE
        WSTR  = WSTR + 1
        IF (WPOS64 - WSTR64) >= I4MAXSZ THEN
          O2SIZE = WSTR64 - WPOS64
          EXIT DO
        ELSE
        ENDIF
      ENDIF
    LOOP
  END IF
END SUB
/******************/
/* 最大値を求める */
/******************/
FUNCTION MAX(I1A AS DOUBLE,I2B AS DOUBLE) AS DOUBLE
  DIM WKMAX AS DOUBLE
  IF I1A >= I2B THEN
    WKMAX = I1A
  ELSE
    WKMAX = I2B
  ENDIF
  MAX = WKMAX
END FUNCTION
/******************/
/* 最小値を求める */
/******************/
FUNCTION MIN(I1A AS DOUBLE,I2B AS DOUBLE) AS DOUBLE
  DIM WKMIN AS DOUBLE
  IF I1A <= I2B THEN
    WKMIN = I1A
  ELSE
    WKMIN = I2B
  ENDIF
  MIN = WKMIN
END FUNCTION
/**************************/
/* ニューメリックチェック */
/**************************/
FUNCTION NUMCHK(I1STRP AS *BYTE) AS LONG
  DIM I AS LONG,SW AS LONG
  FOR I = 0 TO lstrlen(I1STRP) - 1
    IF I1STRP(I) >= &H30 AND I1STRP(I) <= &H39 THEN
      SW = TRUE  '数字なら真
    ELSE
      SW = FALSE '数字以外なら偽
      EXIT FOR
    END IF
  NEXT
  NUMCHK = SW
END FUNCTION
/*****************************/
/* 文字列検索(Instrと同仕様) */
/*****************************/
FUNCTION SUBSTR(I1STRP AS *BYTE,I2STRP AS *BYTE) AS LONG
  DIM POSP AS *BYTE
  DIM PLEN AS LONG
  POSP = strstr(I1STRP,I2STRP) 'Cのstrstr使用
  IF POSP = NULL THEN
    PLEN = 0
  ELSE
    PLEN = POSP - I1STRP + 1
  END IF
  SUBSTR = PLEN
END FUNCTION
/**************************/
/* ２変数の内容を交換する */
/**************************/
SUB SWAP(IO1 AS *BYTE,IO2 AS *BYTE,I3 AS LONG)
  DIM I AS LONG
  DIM WORK AS BYTE
  FOR I = 0 TO I3 - 1
    WORK = IO1(I)
    IO1(I) = IO2(I)
    IO2(I) = WORK
  NEXT
END SUB
/****************************/
/* 文字列末尾のスペース削除 */
/****************************/
SUB TRIM(I1 AS *BYTE)
  DIM I AS LONG
  FOR I = lstrlen(I1) - 1 TO 0 STEP - 1
    IF I1(I) <> SP THEN
      EXIT FOR
    ELSE
      I1(I) = 0
    END IF
  NEXT
END SUB
/****************************/
/* 文字列先頭のスペース削除 */
/****************************/
SUB TRIMH(I1 AS *BYTE)
  DIM I AS LONG,J AS LONG,K AS LONG,L AS LONG,M AS LONG
  L = lstrlen(I1) - 1
  M = 0
  FOR I = 0 TO L
    IF I1(I) <> SP THEN 'スペース以外なら抜ける
      EXIT FOR
    ELSE
      M = M + 1
    END IF
  NEXT
  IF M = 0 THEN '先頭スペースなしの時は当処理から抜ける
    EXIT SUB
  ELSE
    K = 0
    FOR J = I TO L + M
      IF J <= L THEN
        I1(K) = I1(J)
      ELSE
        I1(K) = 0
      END IF
      K = K + 1
    NEXT
  END IF
END SUB
/******************************/
/* テキスト行のバイト数を取得 */
/******************************/
FUNCTION ZSTRLEN(I1STRP AS *BYTE) AS LONG
  DIM I AS LONG,J AS LONG
  I = 0
  DO
    IF I1STRP(I) = CR AND I1STRP(I + 1) = LF THEN '行末？
      J = 2
      EXIT DO
    ELSE
      IF I1STRP(I) = 0 THEN 'データの終わり？
        J = 0
        EXIT DO
      ELSE
        I = I + 1
      END IF
    END IF
  LOOP
  ZSTRLEN = I + J
END FUNCTION
END