Kinglion
铂金会员
痴迷ＤＯＳ者
积分 5792
发帖 1921
注册 2003-6-20
来自 金獅電腦軟體工作室
状态 离线
|
『第
5 楼』:
我在工作中使用過的一個 BASIC 語言程式
我在工作中使用過的一個 BASIC 語言程式，希望對樓主有幫助。
ON ERROR GOTO ErrorProc
DIM DATEN AS LONG
DIM DATENR AS LONG
DIM Filenum AS INTEGER
TIMEN=VAL(MID$(TIME$,1,2)+MID$(TIME$,4,2)+MID$(TIME$,7,2)) ' 时间
SELECT CASE COMMAND$
CASE IS = "/H"
CLS
CALL TESTCCDOS
END
CASE IS = "/h"
CLS
CALL TESTCCDOS '
END
CASE IS = "/?"
CLS
CALL TESTCCDOS '
END
CASE IS = ""
CLS
FileNum = FREEFILE
SHELL "D:"
SHELL "MD C:\COMPRESS"
SHELL "CD C:\COMPRESS"
OPEN "C:\TEMP\BACKDATE.DAT" FOR RANDOM AS #1 ' 判断当日是否已备份
IF LOF(1)=0 THEN
CLOSE #1
KILL "C:\TEMP\BACKDATE.DAT"
ELSE
CLOSE
Filenum% = FREEFILE
OPEN "C:\TEMP\BACKDATE.DAT" FOR INPUT AS Filenum%
LINE INPUT #Filenum%, L$
CLOSE Filenum%
DATENR=VAL(L$)
END IF
IF DATENR=DATEN THEN ' 如果已经备份则退出
SHELL "C:"
SHELL "CD\"
SHELL "RD C:\COMPRESS"
SYSTEM
ELSE
CALL PROMPT
SDATE$ = RIGHT$(DATE$, 4) + "年" + LEFT$(DATE$, 2) + "月" + MID$(DATE$, 4, 2) + "日"
STIME$ = LEFT$(TIME$, 2) + "时" + MID$(TIME$, 4, 2) + "分" + RIGHT$(TIME$, 2) + "秒"
RT = VAL(LEFT$(TIME$, 2))
IF RT > 11 THEN AP$ = "下午" ELSE AP$ = "上午"
IF RT > 12 THEN STIME$ = RIGHT$(STR$(RT - 12), 2) + RIGHT$(STIME$, 10)
RUN$="数据文件备份日期及时间: "
BACKDATE$ = RUN$ + SDATE$ + AP$ + STIME$
BACKUP$ = RIGHT$(DATE$, 4) + LEFT$(DATE$, 2) + MID$(DATE$, 4, 2)
SHELL "C:"
SHELL "CD\"
SHELL "RD C:\COMPRESS"
Filenum% = FREEFILE
OPEN "C:\TEMP\BACKDATE.DAT" FOR OUTPUT AS Filenum%
PRINT #Filenum%, LEFT$(MID$(STR$(DATEN),2,8),8)
PRINT #Filenum%, BACKDATE$
PRINT #Filenum%, " 郑重声明:本文件为■■■■■■■■■■■■■备份工具标识文件，切勿做任何修改。"
CLOSE Filenum%
SHELL "CD\"
END IF
END SELECT
SYSTEM
SUB TESTCCDOS
DIM A%(50)
DEF SEG = VARSEG(A%(0))
RESTORE
FOR I% = 0 TO 37
READ D%
IF I% = 4 THEN
D% = VARPTR(A%(49)) MOD 256
ELSEIF I% = 5 THEN
D% = VARPTR(A%(49)) / 256
END IF
POKE VARPTR(A%(0)) + I%, D%
NEXT I%
CALL ABSOLUTE(VARPTR(A%(0)))
DEF SEG
IF A%(49) = 0 THEN
CLS
LOCATE 2, 2: PRINT "BACKUP R0.03 System data files backup utility - Compile date: 2000.03.18"
LOCATE 3, 2: PRINT " "
LOCATE 3, 2: PRINT "Copyright (c) 1993, 2000 Kinglion software workroom, all rights reserved."
LOCATE 4, 2: PRINT
LOCATE 5, 2: PRINT "Usage: BACKUP [/H] | [/h] | [/?] "
LOCATE 6, 2: PRINT
LOCATE 7, 2: PRINT " /H or /h or /? : view the help"
LOCATE 8, 2: PRINT
LOCATE 9, 2: PRINT " No parameter, run the auto mode."
LOCATE 11, 2: PRINT " If you used CCDOS, Program will show GB Chinese char and more message."
PRINT
SHELL "CD\"
END
ELSE
CLS
LOCATE 2, 2: PRINT "BACKUP R0.03 ■■■■■■■■■■数据文件备份工具 编译日期: 2000年03月18日"
LOCATE 3, 2: PRINT ""
LOCATE 3, 2: PRINT "版权所有: (C) 金狮计算机软件工作室 窦杰晖, 保留所有权利."
LOCATE 4, 2: PRINT ""
LOCATE 5, 2: PRINT "用法: BACKUP [/H] | [/h] | [/?] "
LOCATE 6, 2: PRINT ""
LOCATE 7, 2: PRINT " /H 或 /h 或 /? : 显示本帮助 "
LOCATE 8, 2: PRINT ""
LOCATE 9, 2: PRINT " 没有命令行参数, 程序运行于自动备份模式."
PRINT
SHELL "CD\"
END IF
END SUB
SUB PROMPT
DIM A%(50)
DEF SEG = VARSEG(A%(0))
RESTORE
FOR I% = 0 TO 37
READ D%
IF I% = 4 THEN
D% = VARPTR(A%(49)) MOD 256
ELSEIF I% = 5 THEN
D% = VARPTR(A%(49)) / 256
END IF
POKE VARPTR(A%(0)) + I%, D%
NEXT I%
CALL ABSOLUTE(VARPTR(A%(0)))
DEF SEG
IF A%(49) = 0 THEN
YEAR$=MID$(DATE$,7,4)
MOUTH$=MID$(DATE$,1,2)
TODAY$=MID$(DATE$,4,2)
SBACKUP$ = RIGHT$(DATE$, 4) + LEFT$(DATE$, 2) + MID$(DATE$, 4, 2)
CC$ = "PKZIP.EXE -a -exx -p -r -o -= -a+ -n+ -! C:\TEMP\" + SBACKUP$ + ".ZIP C:\BC5\BIN\*.C > NUL"
CPPC$ = "PKZIP.EXE -a -exx -p -r -o -= -a+ -n+ -! C:\TEMP\" + SBACKUP$ + ".ZIP C:\BC5\BIN\*.CPP > NUL"
HC$ = "PKZIP.EXE -a -exx -p -r -o -= -a+ -n+ -! C:\TEMP\" + SBACKUP$ + ".ZIP C:\BC5\BIN\*.H > NUL"
SHELL CC$
SHELL CPPC$
SHELL HC$
SDATE$ = RIGHT$(DATE$, 4) + "." + LEFT$(DATE$, 2) + "." + MID$(DATE$, 4, 2)
STIME$ = LEFT$(TIME$, 2) + ":" + MID$(TIME$, 4, 2) + ":" + RIGHT$(TIME$, 2)
ELSE
YEAR$=MID$(DATE$,7,4)
MOUTH$=MID$(DATE$,1,2)
TODAY$=MID$(DATE$,4,2)
SBACKUP$ = RIGHT$(DATE$, 4) + LEFT$(DATE$, 2) + MID$(DATE$, 4, 2)
CC$ = "PKZIP.EXE -a -exx -p -r -o -= -a+ -n+ -! C:\TEMP\" + SBACKUP$ + ".ZIP C:\BC5\BIN\*.C > NUL"
CPPC$ = "PKZIP.EXE -a -exx -p -r -o -= -a+ -n+ -! C:\TEMP\" + SBACKUP$ + ".ZIP C:\BC5\BIN\*.CPP > NUL"
HC$ = "PKZIP.EXE -a -exx -p -r -o -= -a+ -n+ -! C:\TEMP\" + SBACKUP$ + ".ZIP C:\BC5\BIN\*.H > NUL"
SHELL CC$
SHELL CPPC$
SHELL HC$
SDATE$ = RIGHT$(DATE$, 4) + "年" + LEFT$(DATE$, 2) + "月" + MID$(DATE$, 4, 2) + "日"
STIME$ = LEFT$(TIME$, 2) + "时" + MID$(TIME$, 4, 2) + "分" + RIGHT$(TIME$, 2) + "秒"
RT = VAL(LEFT$(TIME$, 2))
IF RT > 11 THEN AP$ = "下午" ELSE AP$ = "上午"
IF RT > 12 THEN STIME$ = RIGHT$(STR$(RT - 12), 2) + RIGHT$(STIME$, 10)
END IF
END SUB
DATA &H50,&H53,&H56,&HBE,&H00,&H00,&H2E,&HC7,&H04,&H00,&H00,&HB8,&H00,&HDB,&HCD,&H2F
DATA &H3C,&HFF,&H74,&H09,&HB8,&H10,&HDB,&HCD,&H10,&H3C,&HFF,&H75,&H05,&H2E,&HC7,&H04
DATA &H01,&H00,&H5E,&H5B,&H58,&HCB
ErrorProc: ' 程序运行出错处理模块
CLS
SELECT CASE ERR
CASE 2:
LOCATE 10, 20: PRINT "Error: Synatx error. Code: 2"
LOCATE 10, 20: PRINT " DATA语句格式不正确"
GOTO 1000
RESUME
CASE 3:
LOCATE 08, 20: PRINT "Error: RETURN without GOSUB. Code: 3 "
LOCATE 10, 20: PRINT "RETURN 语句前找不到与之匹配的 GOSUB 语句."
GOTO 1000
RESUME
CASE 4:
LOCATE 08, 20: PRINT "Error: Out of DATA Code: 4 "
LOCATE 10, 20: PRINT "执行READ语句时,DATA语句的数据已读完"
GOTO 1000
RESUME
CASE 5:
LOCATE 08, 20: PRINT "Error: Illegal function call Code: 5 "
LOCATE 10, 20: PRINT "超界的参数传送给了数学或字符串函数中."
GOTO 1000
RESUME
CASE 6:
LOCATE 08, 20: PRINT "Error: Overflow Code: 6 "
LOCATE 10, 20: PRINT "运算结果超界,其值超出了整型数及浮点数范围"
GOTO 1000
RESUME
CASE 7:
LOCATE 08, 20: PRINT "Error: Out of memory Code: 7 "
LOCATE 10, 20: PRINT " 所需的内存空间大于可使用的空间!"
GOTO 1000
RESUME
CASE 9:
LOCATE 08, 20: PRINT "Error: Subscript out of range Code: 9 "
LOCATE 10, 20: PRINT "数组元素下标超出了该数组定义的界限. (/AH)"
GOTO 1000
RESUME
CASE 10:
LOCATE 08, 20: PRINT "Error: Duplicate definition Code: 10 "
LOCATE 10, 20: PRINT " 对已被定义的项使用定义语句或重复定义数组!"
GOTO 1000
RESUME
CASE 11:
LOCATE 08, 20: PRINT "Error: Division by zero Code: 11 "
LOCATE 10, 20: PRINT "表达式中除数为零,或指数运算结果为零的负数次幂"
GOTO 1000
RESUME
CASE 13:
LOCATE 08, 20: PRINT "Error: Type mismatch Code: 13 "
LOCATE 10, 20: PRINT "变量的类型与要求不符合."
GOTO 1000
RESUME
CASE 14:
LOCATE 08, 20: PRINT "Error: Out of string space Code: 14 "
LOCATE 10, 20: PRINT "字符串变量超越了分配给字符串的空间"
GOTO 1000
RESUME
CASE 16:
LOCATE 08, 20: PRINT "Error: String formula too complex Code: 16"
LOCATE 10, 20: PRINT "字符串太长或INPUT语句中申请了15个以上字符串变量"
GOTO 1000
RESUME
CASE 19:
LOCATE 08, 20: PRINT "Error: No RESUME Code: 19 "
LOCATE 10, 20: PRINT "程序在处理错误的过程中碰到程序结束标志"
GOTO 1000
RESUME
CASE 20:
LOCATE 08, 20: PRINT "Error: RESUME without error Code: 20 "
LOCATE 10, 20: PRINT "在进入出错捕获子程序前就遇到了RESUME语句"
GOTO 1000
RESUME
CASE 24:
LOCATE 08, 20: PRINT "Error: Device timeout Code: 24 "
LOCATE 10, 20: PRINT "在预定的时间内, 程序没有从驱动器接到信息."
GOTO 1000
RESUME
CASE 25:
LOCATE 08, 20: PRINT "Error: Device fault Code: 25 "
LOCATE 10, 20: PRINT " 驱动器返回硬件出错 "
GOTO 1000
RESUME
CASE 27:
LOCATE 08, 20: PRINT "Error: Out of paper Code: 27 "
LOCATE 10, 20: PRINT "打印机无纸或电源未打开!"
GOTO 1000
RESUME
CASE 39:
LOCATE 08, 20: PRINT "Error: CASE ELSE expected. Code: 39 "
LOCATE 10, 20: PRINT " 在SELECT CASE 语句中, 没有匹配的情况"
GOTO 1000
RESUME
CASE 40:
LOCATE 08, 20: PRINT "Error: Variable requirted Code: 40 "
LOCATE 10, 12: PRINT "在以BINARY方式打开的文件上进行操作时,GET或PUT语句不能定义变量"
GOTO 1000
RESUME
CASE 50:
LOCATE 08, 20: PRINT "Error: FIELD overflow Code: 50 "
LOCATE 10, 18: PRINT "FIELD语句分配的字节大于随机文件中所说明的记录长度."
GOTO 1000
RESUME
CASE 51:
LOCATE 08, 20: PRINT "Error: Internal error Code: 51 "
LOCATE 10, 20: PRINT "Visual BASIC 发生内部故障, 请联系软件开发商."
GOTO 1000
RESUME
CASE 52:
LOCATE 08, 20: PRINT "Error: Bad file name or number Code: 52 "
LOCATE 10, 20: PRINT " 使用的文件名或数字未经OPEN语句说明"
GOTO 1000
RESUME
CASE 53:
LOCATE 10, 20: PRINT "警告: 本终端与服务器未连通, 请重新登录入网"
GOTO 1000
RESUME
CASE 54:
LOCATE 08, 20: PRINT "Error: Bad file mode. Code: 54 "
LOCATE 10, 20: PRINT "错误的文件模式."
GOTO 1000
RESUME
CASE 55:
LOCATE 08, 20: PRINT "Error: File already open Code: 55 "
LOCATE 10, 10: PRINT "OPEN语句要打开已打开的文件, 或用UNK语句对已打开文件进行操作."
GOTO 1000
RESUME
CASE 56:
LOCATE 08, 20: PRINT "Error: FIELD statement active Code: 56 "
LOCATE 10, 16: PRINT "文件GET或PUT语句中使用的记录变量的空间已被FIELD语句占用"
GOTO 1000
RESUME
CASE 57:
LOCATE 08, 20: PRINT "Error: Device I/O error Code: 57 "
LOCATE 10, 12: PRINT "在驱动器进行I/O操作时出现I/O错误, 操作系统不能从错误状态恢复"
GOTO 1000
RESUME
CASE 58:
LOCATE 08, 20: PRINT "Error: File already exists Code: 58 "
LOCATE 10, 20: PRINT "NAME语句定义的文件名已经以文件名的形式在磁盘上使用"
GOTO 1000
RESUME
CASE 59:
LOCATE 08, 20: PRINT "Error: Bad record langth Code: 59 "
LOCATE 10, 04: PRINT "GET或PUT语句中说明的记录变量长度与相应的OPEN语句中说明的记录长度不匹配"
GOTO 1000
RESUME
CASE 61:
LOCATE 08, 20: PRINT "Error: Disk full Code: 61"
LOCATE 10, 15: PRINT "没有足够的磁盘空间完成PRINT,WRITE,CLOSE或写目标文件操作."
GOTO 1000
RESUME
CASE 62:
LOCATE 08, 20: PRINT "Error: Input past end of file Code: 62"
LOCATE 10, 20: PRINT "使用INPUT语句读一空文件,或文件数据已读完"
GOTO 1000
RESUME
CASE 63:
LOCATE 08, 20: PRINT "Error: Bad record number Code: 63"
LOCATE 10, 20: PRINT "在PUT或GET语句中记录的个数小于等于零!"
GOTO 1000
RESUME
CASE 64:
LOCATE 08, 20: PRINT "Error: Bad File Name. Code: 64"
LOCATE 10, 20: PRINT "使用LOAD,SAVE,KILL或OPEN语句时,文件名非法!"
GOTO 1000
RESUME
CASE 67:
LOCATE 08, 20: PRINT "Error: Too many files Code: 67"
LOCATE 10, 16: PRINT "试图用SAVE或OPEN语句建立新文件,使文件目录数超过255个."
GOTO 1000
RESUME
CASE 68:
LOCATE 08, 20: PRINT "Error: Device unavailable Code: 68"
LOCATE 10, 20: PRINT " 需要进入的设备没有联机或不存在."
GOTO 1000
RESUME
CASE 69:
LOCATE 08, 20: PRINT "Error: Communication-buffer overflow Code: 69"
LOCATE 10, 20: PRINT " 在远程通讯中, 接收缓冲区溢出."
GOTO 1000
RESUME
CASE 70:
LOCATE 08, 20: PRINT "Error: Permission denied Code: 70"
LOCATE 10, 20: PRINT "对写保护的磁盘进行写入操作或读写加锁文件!"
GOTO 1000
RESUME
CASE 71:
LOCATE 08, 20: PRINT "Error: Disk not ready Code: 70"
LOCATE 10, 20: PRINT " 软盘驱动器内无盘或磁盘未准备就绪."
GOTO 1000
RESUME
CASE 72:
LOCATE 08, 20: PRINT "Error: Disk-media error Code: 72"
LOCATE 10, 20: PRINT " 磁盘驱动器硬件在磁盘上查出了物理损伤!"
GOTO 1000
RESUME
CASE 73:
LOCATE 08, 20: PRINT "Error: Advanced feature unavailable Code: 73"
LOCATE 10, 20: PRINT "BASIC子程序或函数中使用的参数个数不正确."
GOTO 1000
RESUME
CASE 74:
LOCATE 08, 20: PRINT "Error: Rename across disks Code: 74"
LOCATE 10, 20: PRINT "试图用新的驱动器名更改文件名"
GOTO 1000
RESUME
CASE 75:
LOCATE 08, 20: PRINT "Error: Path/File access error Code: 75"
LOCATE 10, 08: PRINT "在OPEN,MKDIR,CHDIR或RMDIR操作时,DOS无法使路径名与文件名正确地联系起来."
GOTO 1000
RESUME
CASE 76:
LOCATE 08, 20: PRINT "Error: Path not found Code: 76"
LOCATE 10, 20: PRINT "在OPEN,MKDIR,CHDIR或RMDIR操作时,DOS无法找到指定路径."
GOTO 1000
RESUME
CASE ELSE:
LOCATE 08, 20: PRINT "Error: Unforeseen error Code: none"
LOCATE 10, 20: PRINT "出现系统无法预料的错误"
ON ERROR GOTO 1000
END SELECT
1000 LOCATE 12, 20: PRINT "系统数据文件备份失败, 请联系管理员进行处理!"
LOCATE 14, 20: PRINT "System run error, please call administrator!"
LOCATE 20, 20: PRINT
SHELL "CD\"
SYSTEM
|
熟能生巧，巧能生精，一艺不精，终生无成，精亦求精，始有所成，臻于完美，永无止境！
金狮電腦軟體工作室愿竭诚为您服务！
ＱＱ群：８３９３１７０(定期清理不发言者)
个人网站：http://www.520269.cn
电子邮件：doujiehui@vip.qq.com
微信公众号： doujiehui
|
|
