コード:
/*****************************/
/* 住所録データ管理 */
/* 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 "ファイルを更新しますか?(Y/N)"
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 "***** PIAS処理メニュー *****"
LOCATE 1,3
PRINT "1:住所録データを編集する"
LOCATE 1,4
PRINT "2:住所録データを並べ替える"
LOCATE 1,5
PRINT "3:住所録データを表示する"
LOCATE 1,6
PRINT "4:住所録データをCSVに変換する"
LOCATE 1,7
PRINT "5:CSVを住所録データに変換する"
LOCATE 1,8
PRINT "R:新たにファイルを読込む"
LOCATE 1,9
PRINT "W:ファイルを更新する"
LOCATE 1,10
PRINT "X:終了"
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 "1~5、R、W、Xいずれかを指定して下さい。"
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 "1:全データ表示"
LOCATE 1,4
PRINT "2:対象データ表示"
LOCATE 1,5
PRINT "3:ファイル情報表示"
LOCATE 1,6
PRINT "X:終了"
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 "処理を指示して下さい。1:登録、2:修正、3:削除、W:更新終了、X:終了"
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 "修正項目→1:氏名カナ、2:氏名漢字、3:郵便番号、4:住所、5:電話番号"
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 "処理を指示して下さい。Y:継続、X:終了"
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
/**************************/
/* 住所録データCSV変換 */
/**************************/
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 "***** CSV形式変換処理開始 *****";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 "CSV変換処理件数:";PR.N
LOCATE 1,3
PRINT "***** CSV形式変換処理終了 *****";Date$();Time$()
LOCATE 1,28
PRINT "どれかのキーを押して下さい。"
Input$(1)
END SUB
/****************************/
/* 住所録データTEXT変換 */
/****************************/
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 "***** TEXT形式変換処理開始 *****";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 "TEXT変換処理件数:";N
LOCATE 1,3
PRINT "***** TEXT形式変換処理終了 *****";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 "1:氏名カナ順"
LOCATE 1,4
PRINT "2:郵便番号順"
LOCATE 1,5
PRINT "X:終了"
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
/********************************/
/* 1行の最大レコード長を求める */
/********************************/
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
/**************************/
/* 2変数の内容を交換する */
/**************************/
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