TURBO PASCAL senior programming technology and utilities highlights Author: Dong Zhanshan
Foreword
Turbo Pascal is currently the most popular Pascal language on the microcomputer. It provides an integrated software development environment integrating editing, compile, debugging, and online help. The language itself has a large amount of extension of standard Pascal, with efficient numerical calculation capabilities. The low-level call function of the operating system, the strong software development support such as the embedded assembly language, can be used for any type, any size system software and application development. Especially in 1992, the Turbo Pascal 6.0 of Turbo Pascal 7.0, Borland Pascal 7.0, which provides a more convenient, wider programming environment, such as the development environment of DOS real mode software, DOS protection mode software, and Windows software. Pascal can also develop DOS programs not only, but also develop Windows applications. Borland Pascal is the only software development environment that is comparable to Borland C .
This book is a total of three parts. The first part introduces Turbo Pascal advanced programming technology, including Turbo Pascal and compilation language and C language hybrid programming, writing interrupt routines with Turbo Pascal, using process type simplified programming, dynamic array implementation method And how to use extended memory (EMS) and expand memory (XMS) in the program; the second part includes a very useful Turbo Pascal unit: display input and output unit ACRT, string processing unit ASTR, disk operation unit Disk , Hotkey unit popup, database interaction unit DBASE, extended memory unit EMS, expansion memory unit XMS, mathematical function unit MATH, matrix operation unit Matrix, probability distribution function unit Prob and plural operation unit complex; Part III is a utility, including Soft lock driver program, lock hard disk logical partition program, manuscript printing program, find and replace the program (multi-file operation), backup hard disk main boot recorder, database card print program, Batch file to COM file programs and effectively erase Program of confidential documents, etc.
The program floppy disk is provided with the book, and the reader can easily compile operations in the book, or as a tool during software development, the program can be expanded and improved.
This book is suitable for software development programmers, college students, graduate students, and Pascal learners using Turbo Pascal.
The book is a review of the researcher of Mon Wang Road. In the process of the book, many guidance and help from Wang Lujing researchers, thank you this special.
Due to the limited level of the author, the mistakes and improper are inevitable, readers should pay more valuable comments.
Dong Zhanshan in October 1994 in Beijing
Summary This book is the author's experience in experience using Turbo Pascal programming. The content is divided into three parts. The first part introduces Turbo Pascal advanced programming technology, including Turbo Pascal and assembly language and C language hybrid programming, writing interrupt routines with Turbo Pascal, using process type simplified programming, dynamic array implementation method and how to implement Using extended memory (EMS) and expansion memory (XMS) in the program; the second part includes 11 classes very useful Turbo Pascal unit: display input and output unit ACRT, string processing unit ASTR, disk operating unit Disk, heat Key cell popup, database interaction unit DBASE, extended memory unit EMS, expansion memory unit XMS, mathematical function unit MATH, matrix operation unit Matrix, probability distribution function unit PROB and complex operation unit complex; Part III is a utility, including soft lock Drive programs, lock hard disk logical partition programs, manuscript paper print printers, find and replace programs (multi-file operation), backup hard disk main boot recorder, database card printing program, Batch file to COM file programs and effectively erase confidential files Program, etc. This book is suitable for software developers, college students, graduate students and PASCAL learners.
The book was published by School Court Publishing House in 1994. (ISBN 7-5028-124-4)
-------------------------------------------- This book is me The first book was edited, it was the crystallization of my 5 years. In the fall of 1994, I have accumulated a lot of Turbo Pascal programs, some already published in the magazine, but still have a lot of programs stored quietly in my computer, did not introduce friends who used Turbo Pascal programming. Under the support and encouragement of Wang Lujing researchers in China Academy of Agricultural Sciences, I will classify the material of the materials that have accumulated for many years, and write the necessary documentation, forming this book. During the publication of this book, I hope that the company's Qin Renhua teacher is strongly assisted, and finally published by Beijing Xueyuan Publishing House (1994, a total of 223 pages, 330,000 words, ISBN 7-80124-493-1). The preface of this book details the content and reader objects of this book. Although Turbo Pascal is a programming environment under DOS, when you transfer to a Delphi environment, you will find that the algorithm and program structure of many programs in this book do not need to be changed, and it is still available directly. In view of this, I will completely publish this book online, share with the majority of Delphi or Kelix programmers. Use the link below to browse all of the contents of this book. I hope to have a certain help to your learning and programming. Welcome issues and recommendations. Download all source programs and executables of this book. Chapter 1 Turbo Pascal Advanced Programming Technology 1.1 Unit and Its Use 1.2 and Compilation Language Mixed Programming 1.3 and C Language Mixed Programming 1.4 Process Type and Its Use 1.5 Interrupt Routine Writing method 1.6 Dynamic array and its use 1.7 Expansion Memory (EMS) And the method of using 1.8 extended memory (XMS) and its standard data for use 1.9 procedures
Chapter 2 Utility Unit 2.1 Screen Input and Output Unit ACRT 2.2 String Processing Unit ASTR 2.3 Disk Operation Unit Disk 2.4 Hot Key Unit Popup 2.5 Database Interaction Unit DBASE 2.6 Extended SMS EMS 2.7 Extended Memory Unit XMS 2.8 Mathematical Function Unit Math 2.9 Matrix Computing Unit Matrix 2.10 Probability Distribution Function Unit Prob 2.11 Complex Complex CoMPLEX
Chapter 3 Utilities 3.1 Soft Lock Drive Procedure 3.2 Lock Hard Disk Logo 3.4 Source Procedure List 3.5 Finding and Replacing 3.6 Backup Hard Disk Main Boot Sector 3.7 Si Tong - PC Text File Translation 3.8 SPT File Two-way conversion program with BMP files 3.9 Database card printing program 3.10 Batch file Convert to COM file program 3.11 Confidential file effective destruction program 3.12 Release memory program
Appendix 1 Source Program File Index Table Appendix 2 Various display cards and display modal tables
references
--------------------------------------------- Chapter 1 Turbo Pascal Advanced Programming Technology Turbo Pascal is a product of Borland International, accounting for absolute advantages in the microcomputer PASCAL market. It overcomes the defects that occupy a large amount of memory, and make a lot of beneficial expansion to standard Pascal, such as its ability to deal with low-level software and hardware, with powerful graphic image function, support object-oriented programming Method, support Windows programming, etc. It is a veritable general system programming language, which is very suitable for developing some advanced applications, database management systems, compilers, etc. In addition, Turbo Pascal is also equipped with a high-performance integrated software development environment, including editing, compiling, debugging, file management and other functions. This chapter describes how to use Turbo Pascal development software practical technology, describe how to use some tools and technologies to provide convenience for Turbo Pascal programmers. This chapter will tell the technique of using units in programming, Turbo Pascal and assembly language and C language mixed programming technology, implement and use dynamic array technologies, write interrupt routines, using extended memory (EMS) and expansion in the program Method of memory (XMS) and methods of processing the standard data of the program, etc. §1.1 unit and its use
The unit is a set of Turbo Pascal processes and functions that can be compiled separately with the Turbo Pascal program. Since the unit is compiled separately, the program is used to compile speed. Moreover, a separate unit can be used for multiple programs. The advantages of making full use of units can not only speed up the development speed of the software, but also improve program maintenanceability.
§1.1.1 Structure of Unit
A unit has two partial composition - interface part and implementation. Such as:
Unit
1. The interface portion of the interface part unit is starting from the reserved word interface, between the unit head and the implementation portion. In this section, a common constant, type, a variable, and a header of the function are described. A program If a unit is used, it can access all variables, data types, procedures, and functions defined by the interface part of the unit. The interface part contains only the headers of the process and functions. The implementation part of the process and function is defined in the implementation part of the unit. Using a unit in the program only needs to know how to call the unit in the unit, without having to know how the process is implemented. 2. Implementation part of the implementation is started by the reserved word impLementation. Implementation part defines all processes and functions of all declarations in the interface part. In addition, the implementation can have its own description, these instructions are partial, and the external program does not know their existence, and they cannot call them. Since all objects declared in the implementation section are local in the field, the change in the implementation is invisible to other units and programs. Therefore, the implementation portion of a unit is modified, and the unit that needs to be recombinated using the unit, only the program is required to compile this modification unit and the program that uses this unit. However, if the interface part has modified, all units and programs that use the unit need to recompile and even need to be modified. In the implementation section, if there is a USES clause, you must follow after the word Implementation is retained. If the process illustrates the External type, you need to use the {$ l file name .Obj} compile instructions to enter the program. In addition to the Inline type, in addition to the Inline type, the head must be consistent with the interface portion or in the abstract format. 3. The entire implementation portion of the initialized part unit is typically included between the reserved word Implementation and End. However, if the reserved word Begin is placed in the END, these statements are the initialization part of the unit. Any variable can be initialized in the initialization portion, which can be used by the unit or by the interface portion. You can open the file for use in this section. For example, the standard unit Printer uses its initialization section to point all output calls to a text file LST, which can be used in the WRITE statement. When executed using the unit of the unit, the initialization portion of all units used in the main body of the program is executed, and the initial call described in the Uses clause is sequentially called. § 1.1.2 Use of the unit
When using the unit, you need to list the names of all units used in the USES statement, and the cells and units are spaced apart from the unit. Such as: Uses DOS, CRT; When the compiler scans it to the USES clause, it applies the interface information of each unit to the symbol table, and connects the machine code of the implementation portion to the program code. 1. Direct references to the unit (program or unit) of a module (program or unit) only list the unit names directly used by the module. For example: program prog; uses unit2; consta = b; beginwriteln ('a =', a); end.
Unit unit2; interfaceuses unit1; constb = c; importAionend.
Unit unit1; interfaceConstc = 1; ImplementationConstb = 2; End.Unit2 Unet1, the main program uses Unit2, indirectly uses Unit1. If there is a change in the interface portion of the unit, all units or programs that use the unit must be recompiled. However, if the implementation of the unit is changed, it is not necessary to recompile. In the above example, if the interface portion of Unit1 is changed (such as c = 2), unit2 must recompile; if only the implementation portion (b = 1) is changed, UNIT2 does not have to recompile. When compiling a unit, Turbo Pascal calculates the number of versions of the unit, which is the checksum of the interface part of the unit. In the above example, when compiling unit2, Unit1's current version number is stored in the compiling version of Unit2. When compiling the primary program, the version of Unit1 is compared to the version number of Unit2, if the two is different, indicating that UNIT2 is compiled. The interface part of Unit1 is changed, the compiler gives an error message and recompile the unit 2.2. The cycle reference of the unit is not visible to the user in the implementation part, so the Uses clause is placed on the implementation portion of the unit. Further hidden the internal details of the unit, and it is possible to construct interdependent units. The following example shows how the two units are referenced. The main program Circular uses the Display unit, and the display unit illustrates the Writexy process in the interface section, there are 3 parameters: coordinate values x and y and the text information to display, if (x, y) inside the screen, Writexy mobile cursor (x, y) and display information, otherwise, the simple error handling process showerror, and the showerror process reverses Writexy to display the error message, which generates the cycle reference problem of the unit. Main program: Program circular; usescrt, display; beginwritexy (1, 1, 'upper left corner of screen "); Writexy (100, 100,' Way of the screen"); Writexy (81-length ('back to reality'), 15, 'back to reality'); end.display unit: Unit Display; InterfaceProcedure Writexy (x, y: integer; message: string); ImplementationUses CRT, Error; Procedure Writexy; Beginif (x in [1..80]) and (y in [1..25]) thenbegingotoxy (x, y); writeln (message); endelseShowError ( 'Invalid Writexy coordinates'); end; end.Error unit: unit Error; interfaceprocedure ShowError (ErrMessage); implementationuses display Procedure ShowError; BeginWritexy (1, 25, 'error:' errmessage); End; End.display and Error unit implementation part of the USES clause of each other, Turbo Pascal can fully compile the interface part of the two units, as long as The interface portion does not depend on each other, and the implementation portion can be called mutual.
§ 1.1.3 Unit and large procedures
The unit is the basis for the Turbo Pascal modular programming, which is used to create processes and function libraries that can use but does not require source programs for many programs, which is divided into multiple related module basis. Typically, a large program can be divided into multiple units that packet them according to the functionality of the process. For example, an editor can be divided into several parts such as initialization, printing, reading and writing files, formatting. Alternatively, there is a "global" unit defining global constants, data types, variables, processes, and functions, which can be used by all units and main programs. The framework of a large program is as follows: Program Editor; USDOS, CRT, Printer, Editglobal; Editinit; EditPrint; EditFile; EditFormat; ... begin ... End. Another reason for using the unit in the development of a large program is Related to the limitations of the code segment. The 8086 processor requires a maximum length of the code segment to 64K. This means that the main program and any unit cannot exceed 64K. Turbo Pascal puts each unit in a separate segment to solve this problem. §1.2 Mixed Programming and Compilation Language
Turbo Pascal is known for its high speed and compact generated target code. In most cases, only a variety of programs can be completed using Turbo Pascal, however, in the hardware interface program, real-time control program, and large-scale floating point operations, it is necessary to program the assembly language. Although Turbo Pascal provides inline statements and commands, as well as the embedded assembly language (Turbo Pascal 6.00), this is not enough. This section discusses the technology of Turbo Pascal and the assembly language mixed programming, and lists a lot of examples.
§ 1.2.1 Turbo Pascal Call Agreement
When the Turbo Pascal program is mixed with the external compilation subroutine, it is read as follows.
§ 1.2.1.1 Ways of calling subroutines and returning ways of subroutines
Turbo Pascal Program When the compilation subroutine can be called, it can be a far-calling, so the Turbo Pascal program is called according to the call mode, and there are two ways to save the address depending on the call mode. : 1 When the time is called, due to the call within the segment, only the offset address IP is in the stack, accounting for 2 bytes; 2 long adjustment, due to paragraph call, to put the code segment value CS and offset address IP in the stack , Accounting for 4 bytes. When the compilation subroutine is called directly in the main program, it is generally used, and the compilation subroutine uses a near-return mode, with the RET instruction; two cases of compilation subroutine in the unit of Turbo Pascal: 1 In the unit interface part Subprogram, in the compilation subroutine, use a remote return, use the RETF instruction; 2 In the unit interpretation part of the subroutine, the assembly subroutine needs to use the RET instruction. After the assembly subroutine is running, in order to correctly return to the calling program, the stack top pointer must point to the correct return address, which gives the number of bytes when the parameter is given in the return instruction RETF (or Ret). Method is achieved.
§ 1.2.1.2 Method of Parameter Transfer
Turbo Pascal is the use of stacking processes and function pass parameters, parameters are pressed into the stack from left to right (described sequence), such as calling process Proc (A, B, C: INTEGER; VAR D), The stack is shown in Figure 1-1.殌 ┌ --──────── ─ ┐│ 0e│ parameter A │ ↑ │ ──────────── ─ │ 参 │ 0c│ parameter b value │ │ 参 │ ├────────── ─ │ │ 0A│TA number C value │ │ Number │ ───────────────────────── ─ │ │ 8│ parameter D Dip address │ │ 出 │ ──────── ─ ┤ │ │ 6│ 参 参 offset address │ │ │ ├─────── ─ ─ ┤ │ │ │ │ │ 顺 │ ├────────────────── ─ ─ │ │ │ 2│ │ 地址 地址 │ │ │ ↓ ├───────────── ─ ┤ │ │ BP register │ └────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────tet Situation Turbo Pascal When the subroutine is called, there are two methods of passing the parameters, namely the method of transmitting the value, and the transmission address. These two parameter transmission methods are described below. Methods of various types of parameters are found in Table 1-1. (1) Parameters in the form of TURBO PASCAL in the form of Turbo Pascal, parameters defined in value-references, and types are various types other than composite types such as records, arrays, strings, pointers, such as bytes. Type (Byte), ShortInt, Integer, Dictionary, Longint, Char, Boolean, Real Number, etc. Turbo Pascal Press the real-gate value from the left to right order when the subroutine is called, and the compilation subroutine can obtain the value of the arguments directly from the stack. (2) In the form of Turbo Pascal's process or function of Turbo Pascal, the parameters defined in variable form, and a value defined by composite type of record, string, array, pointer, and Turbo Pascal in calling subroutines. When it is pressed into the stack in the order from left to right. The assembly subroutine obtains the address of the argument from the stack, you can get the value of the parameter. Similarly, the subroutine can store the calculation result to the corresponding variable to pass back the call. Table 1-1. Methods of various types of parameters. 殌 殌 殌 ┌ - ───────────────── ─ ┐ 形 形 类 │ Transfer method │ │ 中文 节 │├- ────────────────── ─ ┤│char, Boolean │ │ │BYTE, SHORTINT, │ Pick │ 2 │ │INTEGER, WORD │ │ │├─────── ─ ┼────────── ─ ┤│longint, Single│Pators │ 4 │├─────────────────────────────────────────────tes │├─────────────────── ┤│double │ 传 值 │ 8 │├──────────────────────── String, Pointer│Bax Address │ 4 ││ Variables │ │ │ └─────────────────────────────
§ 1.2.1.3 Function return value
The transfer method of the Turbo Pascal function returns varies depending on the function return value type, there is a way of transmitting the address, and there is also a register mode, such as the way of using the video, its address (4 bytes) first, Then press the function parameters, and finally press the return address of the function. Table 1-2 is shown in the transmission method of various functions return types.
Table 1-2. Delivery mode of various functions returned - 殌 - ──────────────────── ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ │ Terminal │ ├───────────────────────────── ─ ─ │ │ 1 │ │char, Shortint │ │ │ ───────────────────────── ─ │ in Register AX │ 2 │ ├────── ┼ ─────────────── ─ ─ ─ ─ ─ ─ ─ ─ │ 4 │ ├────────────────────── ┼──── ─ ┤│REAL │ is high to low in DX, BX, AX │ 6 │├─────────────────────────────────────── ─ ┤│POINTER │ segment address in DX, offset in AX │ 4 │├─────────────────────────────── ─ ─ ─ ┤│tring │ in DS: Si's address │ unlimited │ └ └──────────────────────────────────────────────────── / The general writing format of the external compilation subroutine is as follows: Title program name dosseglocals @@. Model tpascal.codessume cs: @codepublic process or function name process or function name: Push BPMOV BP, sp ... Pop BPRETF parameter stack word The number of candidates end the above-mentioned subprogramme is the format of Turbo Assembler, and this document is used in this format. Describe the following compilation subroutine format as follows:. The assembly module should use TPascal mode; in the assembly module, you must explain the process or function of Turbo Pascal call as public attribute;. Subroutine returns the directive to the specific situation, close Use RET, high-conditioning use RETF ;. The parameter after returning instruction refers to the number of bytes of all parameters in the subroutine form parameter table;. The assembly module ends to write END.
§ 1.2.3 Writing format of Turbo Pascal Program
In Turbo Pascal, the format of the external subroutine is as follows: Procedure PRC (A, B: Integer; Var C: REAL); External; Function Func (A, B: Integer): real; external; ie in the usual Turbo Pascal Declaration of procedures or functions plus the external keyword. In the main program or program unit that declares an external process or function, load the compilation target module to load. When using an external assembly process or function in the Turbo Pascal program, the method and the general Turbo Pascal process and the function are no different.
§ 1.2.4 Analysis of typical examples of using external compilation subroutines in the main program
When using an external compilation subroutine directly in the Turbo Pascal main program, generally adopt a near-modification method, so the compilation subroutine returns an instruction to RET, and when it is specifically specified, the RETF is returned to the instruction. 1. There is no parametric delivery process program prop1; {$ l pROG1.OBJ} procedure displayok; end.
Title PROG1LOCALS @@ DOSSEG.MODEL TPASCAL.CODEASSUME CS: @CODEOkMsg db 'OK!', 0dh, 0ah, '$'; Procedure DisplayOkPUBLIC DisplayOkDisplayOk: push ds; save the data segment push cs; code segment stack pop ds; pop-up data Segment MOV AH, 09; Display String MOV DX, OFFSET OKMSG; String Address INT 21H; DOS Function Call POP DS; Restore Data Segment RET; Near Return END; Compilation Sub Module End 2. Process of Password Value
Program prog2; {$ l pROG2.OBJ} Procedure Displayint (CH: char); external; begindisplayint ('a'); end.
Title PROG2LOCALS @@ dosseg.model tpascal.codessume cs: @code; procedure DISPLAYINTPUBLIC DISPLAYINTDISPLAYINT: PUSH BPMOV BP, SPMOV AH, 02; Display Character MOV DL, [BP 4]; Take Parameters INT 21H in the Stack; DOS Function Call POP BPRET 2; form parameters in the stack 2 byte end
3. Process of passing characters value ginseng and integer parameters
Program prog3.obj} Procedure Procarg (CH: CHAR; VAR i: integer; external; var i: integer; beginprocarg ('d', i); Writeln (i); end.title pROG3LOCALS @@ Dosseg.model tpascal.codessume cs: @code; procedure procargpublic ProcargProcarg: Push BPMOV BP, SPXOR AX, AXMOV AL, BYTE PTR [BP 8]; Take the character parameter LES SI, [BP 4]; Take the address of the total variable MOV ES: [Si], Alpop BPRET 6; form parameters account for 6-byte end in the stack
4. Pass the character value to return to the integer
Program prog4; {$ l pROG4.OBJ} Function func (ch: char): integer; execnal; beginwriteln (FUNC ('a')); end.
Title PROG4LOCALS @@ dosseg.model tpascal.codeassume cs: @code; procedure funcpublic funcfunc: Push BPMOV BP, SPXOR AX, AXMOV AL, BYTE PTR [BP 4]; Take the character parameter value POP BPRET 2; form parameters in the stack 2 byte end; subroutine return value in register AX
5. Transferring string type value ginseng and returns a string type function
program prog5; {$ L prog5.obj} function func (s: string): string; external; beginwriteln (func ( 'abcd')); end.Title PROG5LOCALS @@ DOSSEG.MODEL TPASCAL.CODEASSUME CS: @CODE; Procedure Funcpublic funcfunc: Push BPMOV BP, SPPUSH DSXOR CH, CHLDS SI, [BP 4]; Take the address of string s LES DI, [BP 8]; Take the return value address MOV CL, [Si] Inc CLCLD @@ 1 : lodsbstosbloop @@ 1pop DSPOP BPRET 4; The address of the string S accounts for 4 bytes end6 in the stack. Transfer long-interanous value ginseng and return long integer functions
Program prog6; {$ l pROG6.Obj} function func (longint): longint; external; var i: longint; begini: = func (111111110); Writeln (i); END.
Title PROG6LOCALS @@ dosseg.model tpascal.codeassume cs: @code; procedure funcpublic funcfunc: push bpmov BP, Spmov AX, [BP 4]; Delivering the total number of high MOV DX, [BP 6]; take long Type low LES Si, [BP 8]; Take the function Return Address MOV ES: [Si], DXMOV ES: [Si 2], Axpop BPRET 4; Long Integer LI In the stack 4 byte end
7. Transfer realistic value ginseng and return real-type functions
Program prog7.obj} function func (r: real): real; external; var r: real; beginr: = func (11111.1110); Writeln (r); end.
Title Prog7locals @@ dosseg.model tpascal.codessume cs: @code; procedure funcpublic funcfunc: Push BPMOV BP, SPMOV AX, [BP 4]; Take the value of count R MOV BX, [BP 6]; MOV DX, [ BP 8]; LES SI, [BP 0AH]; Return Address MOV ES: [Si], DXMOV ES: [Si 4], AXPOP BPRET 6; Real R 6 byte end in the stack
---------------------------------------------- you are a wind I am sand, the forum is my home
PS: "Sands" is my old ID, "water-wood sand": = "Snow people" newly registered a ID - Passbyword, or me. 2003-4-2 15:53:23 Sands Title: Webmaster Level: Administrator Prestige: 2 Articles: 927 Points: 1863 School: Anti-Day Alliance Registration: 2002-8-4 4th Floor
§ 1.2.5 Situation of using assembly modules in units
In the following demo unit DEMOU, two external assembly functions are declared, and P1 is defined in the unit interface portion, and the far return mode is used in the assembly module, and P2 is declared in the interpretation section of the unit, and near-return in the assembly module the way. In the process P3 of the unit Demou, functions P1 and P2 are called, and P2 is called P2, which is closeup, no problem; when the P1 is called, because it is defined in the interface part, it must be used for a long modification, which can be compiled instruction { $ F} to complete, before calling P1, plus {$ f }, after calling, add {$ f-}. Program prog8; uses demou; Beginif P1 (1) THEN WRITELN ('Far Call Complete!'); P3; End.
Unit demou; InterfaceFunction P1 (A: Integer): Boolean; Procedure P3; Implementation {$ l demou.obj} function p1 (a: integer): boolean; external; function p2 (a: char): boolean; external; procedure p3 Beginif P2 ('a') THEN WRITELN ('Near Call Complete!'); {$ F }; Open Five Monitor Compilation Instruction IF P1 (1) Then Writeln ('Far Call Again!'); {$ f-} Close the long adjustment of compilation instructions End; End.
Title demoulocals @@ dosseg.model tpascal.codessume cs: @code; function p1public p1p1: push bpmov bp, spxor ax, axc, xi, [bp 4] jnz @@ 1mov al, 0jmp @@ 2 @@ 1: MOV Al , 1 @@ 2: POP BPRETF 2; This function is defined in the unit interface part; Function P2public P2P2: Push BPMOV BP, Spmov AX, 'A'CMP AX, [BP 4] jnz @@ 3mov Al, 0JMP @@ 4 @@ 3: MOV Al, 1 @@ 4: POP BPRET 2; This function is defined in unit interpretation part
§ 1.2.6 Small knot
This section describes the techniques of Turbo Pascal and assembly language mixed programming, and gives a number of typical examples, readers can refer to the format of the instance to make a mixed language programming, solve specific problems in work. Advanced language and assembly language hybrid programming is a more complicated thing, only in practice, accumulating experience, can improve. When commissioning the program written in the mixed language, you may wish to use Turbo Debugger, which can help you find that many incorporated language errors that are not easy to discover, facilitate speeding up the program's development process.
§ 1.3 and C language mixing programming
In general, the mutual call between advanced languages is more difficult. For Turbo Series Software, Borland provides a language-called interface mechanism between language, which describes the method steps of Turbo Pascal and Turbo C / C mixed programming. Turbo Pascal's call protocol has been described in the previous section, and details will not be described here.
§ 1.3.1 Write and compilation of Turbo C / C programs
The general form of modules prepared by Turbo C is as follows: / * c Moduler for Turbo Pascal * / Type 1 FAR Function Name 1 (Distreads) / * Definitions in Unit Interface * / {...} Type 2 Near Function Name 2 (Die Note) / * Decisive * / {...} in the program or unit implementation
Where the first function will use the call mode description FAR, which is defined in the interface part of the Turbo Pascal unit, which needs to be used. The second function uses the NEAR call mode, which is defined in the implementation of the unit or in the program, using a close-up. Writing the Turbo C module used by the Turbo Pascal program should follow the following rules: (1) In the implementation section of the Turbo Pascal unit or the C function directly defined in the main program, the call type should be explained as NEAR; in the interface part of the Turbo Pascal unit The defined C function, the call type should be described as FAR; (2) Public data should be defined in the Turbo Pascal program, the data defined in the Turbo C module cannot be referenced by the Turbo Pascal program; (3) Due to the correct paragraph, Turbo The runture routine of the C / C cannot be used in the Turbo C module. However, when you have the source code of the Turbo C / C Run the library routine, you can include the prototype of the enabler routine in your C module, and recompile the single library routine module so that you can use the associated library routine; The writable Turbo C / C program module is compiled into a target file, and you need to follow the following rules: (1) Any C module is compiled with small memory mode (SMALL); (2) Generate the Turbo C / C code generation compilation switch Set to the PASCAL; (3) Segment name Set as follows: Code Names Segment Name Set to Code, Group Name and Class Name Set to Empty; Data Names Segment Name Set to Const, Group Name and Class Name Set to Empty; BSS Names Segment Name Set to Data, Group Name, and Class Name to be set to empty; or use the Turbo C / C configure file Turbo C / C provided on the Turbo Pascal system to compile the source program of the C module. The method is 2: (1) In the TurboC.cfg and C module subdirectory, the TCC C module name .c (2) Execute: tc /cctopas.tc C Module name .C to compile the C module as a target module, That is to reference in the Turbo Pascal program. Where ctopas.tc and turboc.cfg can be found on Turbo Pascal or Turbo C system disks.
§ 1.3.2 Writing of Turbo Pascal Program
The Turbo Pascal program is not different from the ordinary Turbo Pascal program, just defines the associated C function as an external function, and connects the C module's target module (.Obj) to the Pascal program with the compilation switch {$ L file name}.
§ 1.3.3 Examples of using Turbo C functions in procedures
Using the Turbo C module defined in the main program of Turbo Pascal, the functions in the C module are generally defined as the Near call type. Examples are as follows: Pascal Main Program CPASDemo.pas: Program CpasDemo;
Uses CRT;
Varfactor: Word;
{$ L cpasDemo.obj}
Function SQR (i: integer): Word; External; {Change the text color and return the Square of i} function hibits (w: word): word; external; {change the text color and return the high byte of w}
Function SUC (B: byte): Byte; External; {Change the text Color and return b 1}
Function UPR (C: Char): char; external; {Change the text color and return the Upper case of c}
Function prd (s: shortint): shortint; external; {Change the text color and return s - 1}
Function Lobits (l: longint): longint; external; {Change the text color and return the low word of l}
Procedure strupr (var s: string); external; {Change the text color and return the Upper case of s-note That} {The Turbo C Routine Must Skip The length byte of the string.
Function Boolnot (B: Boolean): Boolean; External; {Change The text Color and return not b}
Function MultByFactor (W: Word): Word; External; {Change The text Color and return w * factor - note} {Turbo C's Access of Turbo Pascal's Global Variable.
Procedure setColor (NewColor: Byte); {a procedure this change color by Changing the crt} textattr: = newcolor; {variable textttr} end; {setcolor}
Vars: String;
Beginwriteln (SQR (10)); {Call Each of the functions defined} Writeln (Hibits (30000)); {Passing it the appropriate info.} Writeln (SUC (200)); Writeln (UPR ('x')); Writeln (PRD (-100)); WRITELN (Lobits (100000)); S: = 'Abcdefg'; StruPR (s); Writeln (S); Writeln (False); Factor: = 100; Writeln (MultByFactor (10)); setColor (lightgray); end.
C Module CpasDemo.c: type; type; type; type;
extern void setcolor (byte newcolor); / * procedure defined inTurbo Pascal program * / extern word factor; / * variable declared in Turbo Pascal program * / word sqr (int i) {setcolor (1); return (i * i); } / * sqr * /
Word Hibits (Word W) {setColor (2); Return (W >> 8);} / * hiBITS * /
BYTE SUC (BYTE B) {setColor (3); return ( b);} / * SUC * /
BYTE UPR (Byte C) {setColor (4); Return ((c> = 'a') && (c <= 'z')? C - 32: C);} / * upr * /
Char prop (CHAR S) {setColor (5); return (- s);} / * prd * /
Long Lobits (long L) {setColor (6); return (longword) l & 65535);} / * lobits * /
Void Strupr (Char Far * s) {Int Counter;
For (counter = 1; counter <= s [0]; counter ) / * Note That the routine * / s [counter] = UPR (s [counter]); / * Skips Turbo Pascal's * / setColor (7); / * Length Byte * /} / * strupr * /
BYTE BOOLNOT (BYTE B) {setColor (8); return (b == 0? 1: 0);} / * boolnot * /
Word MultByFactor (Word W) {setColor (9); / * Note That this function Accesses the turbo pascal * / return (w * factor); / * Declared variable factory * /} / * multibyfactor * /
§ 1.3.4 Examples of Turbo C functions in Turbo Pascal cells
In the Turbo Pascal unit, use the Turbo C module defined function, the modulation mode of the function in the C module can be two types of NEAR and FAR. A simple example is given below. Pascal main program cpdemo.pas: program ctopasdemo;
Uses cpunit;
BeGinwriteln (Add2 (3)); DisplaySub2 (3); end.
Pascal unit cpUnit.pas: Unit cpunit;
Interface
Function add2 (x: integer): Integer; Procedure DisplaySub2 (x: integer);
IMPLEMENTATION
{$ L ctopas.obj}
Function Add2; External; Function Sub2 (x: integer): integer;
Procedure DisplaySub2; BeginWriteln (SUB2 (X)); END;
End.
C Module Ctopas.c: Int Far Add2 (INT X) {Return (x 2);
INT SUB2 (INT X) {RETURN (X - 2);
Turbo Pascal and Turbo C are currently more popular programming languages, and if the programmers can use Turbo Pascal and Turbo C to make a half-time effect, the development of the software can be accelerated. § 1.4 Process type and its use
Turbo Pascal allows the use of process types, processes or functions as objects that can be assigned to variables or pass to parameters. In the process type description, the parameters of the process or function are defined and the return type of the function is defined.
§ 1.4.1 Description of Process Type
The method of process type is as follows: typeProc0 = procedure; proc1 = procedure (x: integer); func0 = function: integer; func1 = function (x: integer): boolean; process type description The parameter name is completely decorative, There is no practical meaning.
§ 1.4.2 Process type constant
Process type constants must specify the identifier of the process or function, and the process or function must be compatible with the type of constant. For example: TypeErrorProc = Procedure (ErrorCode: integer); Procedure DefaultError (ErrorCode: integer); far; beginWriteln ( 'Error', ErrorCode, '.'); End; constErrorHandler: ErrorProc = DefaultError;
§ 1.4.3 Process type variable
After the process type description, it can be used to define the variable, which is called the process variable. Such as: VARF01, F02: FUNC0; F11, F12: FUNC1; P1: Proc1; like integer variables, process variables can be assigned. The process value can be another process variable, one can be an identifier of a process or function. For example, there is a process and function description: Function F1: Integer; Far; Beginf1: = 1; END;, the following statement is true: f01: = @ f1; f02: = f01; assign function or process to process variables, The following requirements must be met: function or process must be a FAR call type. Can't be a standard process or function. Can't be an embedded process or function. Can't be an inline process or function. Cannot be an interrupt process process type is not limited to simple variables, Like other types, process type variables can be used as components of structural types. Such as: typeGotoProc = procedure (x, y: integer); procList = array [1..10] of GotoProc; WindowPtr = ^ WindowRec; WindowRec = RecordNext: WindowPtr; Header: string [31]; Top, Left, Bottom, Right : Integer; set; varp: proClist; w: windowptr; after this description, the following statement is a legal process call: P [3] (1, 1); W ^ .SetCursor (10, 10); process The value is assigned to the process variable, and it is actually putting the address of the process into the variable. The process variable is very like a pointer pointer, just a pointer variable points to the data, process variable points to the entry of the process or function. The process variable accounts for 4 bytes, the offset of the first word save address, the second word deposition address.
§ 1.4.4 Process Types in Expression
Typically, in the statement or expression of the process variable indicates the call to the process or function stored in the variable, there is also an exception, when Turbo Pascal discovers a process variable on the left side of an assignment statement, it thinks that the right side must be a process value. For example: typeintfunc = function: integer; var; function readint: integer; far; var i: integer; beginreadln (i); readint: = i; me; beginf: = read; END. The first statement in the main program assigns the process value readint to the process variable f, the second statement calls readint, and returns the return value to N. The statement: if f = readint kiliteln ('equal'); interpretation is to call f and readint, then compare their return values, if equally, print Equal. To compare the F and Readint's process values, you must use the following structure: if @f = @Readint Then Writeln ('equal'); when a process variable or process is given, the function identifier is when the function identifier is, the address operator @ can block The compiler calls the process, the function, and converts the parameters to a pointer, @f converts F to the non-type pointer containing the address, @ readint Returns the address of the Readint. When you want to get the memory address of the process variable, you must use two address operators (@@). For example, @ f means converts F to a non-type pointer variable, @@ f indicates the physical address of returning the variable F.
§ 1.4.5 Process Type Parameters
Since the process type can be used any occasion, the process type can be passed as a process or function parameter, so that in some occasions can greatly simplify the programming of the program. The following two describes the use of process parameters. Using the SIMPSON formula, S = ∫ 攩 B mixed A 攭 f (x) dx. Adopt gradual approximation approximation method: s = h / 3 * (f 0 攭 4 * (f 1 攭 F 3 攭 ... f, N-1 攭) 2 * (f 2 攭 F 4 攭 ... f takes N-2 攭 F N 攭), where F takes I 攭 = F (A I * H), h = (ba) / n.
Program Simpson_method;
TYPEFUNC = Function (X: REAL): REAL;
{$ F } Function Simpson (F: Func; A, B: Real; N: Integer): Real; Varh, S: Real; i: integer; beginh: = (ba) / n; s: = f (a) f (b); for i: = 1 to n-1 doif ODD (i) THEN S: = S 4 * f (a i * h) else s: = s 2 * f (A i * h); sIMPSON: = S * h / 3;
Function F1 (x: Real): Real; Beginf1: = SQR (x) * sin (x);
BEGINF2: = 1 / (1 x);
BeGinwriteln ('∫1, 2 (x ^ 2 * sin (x) =', SIMPSON (F1, 1, 2, 10): 10: 2); Writeln ('∫1, 10 (1 / (1 x) ) = ', SIMPSON (F1, 1, 10, 20): 10: 2); END. Using process parameters, design a generic print natural logarithmic and commonly used procedures.
Program printlogtable;
TYPE FUNC = Function (x: integer): Real;
{$ F } function log (x: integer): real; beginlog: = ln (x) / ln (10);
Function LNE (X: Integer): Real; Beginlne: = ln (x);
Procedure PrintTable (I, W: Integer; F: FUNC); Varm, N: Integer; Beginm: = 0; N: = 0; Repeatinc (M); INC (N); Write (M: 3, F (M) : 7: 4, ''); if n = w tellRiteln; N: = 0; end; Until M = I; Writeln; end;
BeginprintTable (1000, 7, LOG); PrintTable (1000, 7, LNE); END.
---------------------------------------------- you are a wind I am sand, the forum is my home
PS: "Sands" is my old ID, "water-wood sand": = "Snow people" newly registered a ID - Passbyword, or me. 2003-4-2 15:55:28 Sands Title: Webmaster Level: Administrator Prestige: 2 Articles: 927 Points: 1863 School: Anti-Japan Union Registration: 2002-8-4 5th Floor
§1.5 Writing method for interrupt routine
Turbo Pascal's runtime and code generated by the compiler are interrupt. Most runtime is reusable, which allows you to write interrupt routines with Turbo Pascal.
§ 1.5.1 Writing Interrupt Routines
The interrupt process can be declared with an Interrupt Directive. Each interrupt program must be used to explain the following procedure: Procedure IntHandle (Flags, CS, IP, AX, BX, CX, DX, Si, Di, DS, ES, BP: WORD); Interrupt; Begin ... End; All registers are passed as parameters, so they can be used and modified in the source code, and some and all parameters can be omitted. When in the entrance, the interrupt process automatically saves all registers and initializes the DS register; the exit code restores all registers and performs the interrupt return instruction.
§1.5.1.1 Framework of Surphorted Interrupt Routines (ISR)
Program program name; {$ m stack length, 0,0} Uses dos; var ... procedure interrupt process name (Flags, CS, IP, AX, BX, CX, DX, Si, DI, DS, ES, BP: Word); IntrRupt; Begin ... End;
BeginsetIntVec (interrupt number, @ interrupt process name); Keep (k); END. The compilation instruction $ m is a Keep process requirement, and the length value of the stack segment is 1024 to 65520, the maximum and minimum heap lengths often explain to 0.
§1.5.1.2 Framework of the temporary interruption routine
Program program name; Uses dos; varp: Pointer; ... Procedure Interrupt Procedure Name (Flags, CS, IP, AX, BX, CX, DX, Si, DI, DS, ES, BP: WORD); IntrRupt; Begin. ..nd; ... begingeTintVec (interrupt number, p); setintVec (interrupt number, @ interrupt process name); ... setintVec (interrupt number, p); end. In the temporary program, set yourself Before the interrupt vector, first store the original interrupt vector to the relevant variables, wait until the end of the program runs, restores all the redefined interrupt vents in the program to the original state. Otherwise, the program will cause a crash after returning the operating system. § 1.5.2 Set the interrupt vector, call the interrupt function, program resident memory
In the program of using the interrupt routine written by yourself, you can use SetintVec to set your own interrupt service: setInTVec (INTNO, @ INTHANDLE); INTNO is the interrupt number, @ IntHandle is the address of the interrupt service process. In the program, INTR procedures can be used to call their own interrupt procedures: INTR (INTNO, Regs); when the interrupt routine written with Turbo Pascal To resident memory, you can use the Keep process to implement: Keep (EXITCODE);
§ 1.5.3 Establish communication data area
Since the code segment address of the interrupt routine can be directly obtained from the interrupt vector table, use this address to add the appropriate address offset, as a subscript of the predefined memory array MEM / MEMW and MEML, you can directly access these specific Memory units, so ISR's communication data area can be established. For example, in order to prevent the same ISR from repeatedly residing in memory, a "resident" flag should be set. If a screen prompts that the screen prompts that the previously displayed on the process of the ISR is given to a dynamic stroke. Usually this prompt string after the display is complete, its content is no longer required, but can be found in the contents of the ISR by reference to the memory array element MEMW [interrupt section address: 1], you can know if the ISR resides, new Can ISR reside.
§1.5.4 Release Retention
A design excellent ISR, when evacuated, the memory it occupies should also be released. In a program compiled with Turbo Pascal 4.0 or higher, there is a predetermined variable prefixseg that saves the start segment address of the program's block prefix PSP. After sending this address as a call parameter to the ES register, then the ISR's 49H function can be released to release the memory itself. In addition to the resident memory space occupied by ISR itself, DOS also assigns a memory space for it as its environment block. A copy of the DOS environment parameters are stored. Although the environment is not large, they also reside. The segment address of the above environment block has been stored at a position of the address offset of the PSP has 2CH. The value of the memory array element MEMW [Prefixseg: $ 2C] is sent to the ES register. When the INT 21h is called again, the ISR's environment block can also be released, thereby recovering all of the ISR's resident space. It is worth noting that if there is a high-end address of the recovered memory space, there is still other unsealed resident blocks, the memory space that has been recovered will become "broken block" in the free chain. These broken blocks will affect future memory allocation. A portion of the part may not be possible again before restarting the system. Therefore, it should first guide those ISRs that do not need to be removed, and ISRs that need to be repeatedly removed are placed in the final boot. In addition, it should be kept in mind that before the ISR resides, be sure to restore the original interrupt vector, otherwise the system is confusing, causing a crash or other fault. It is possible to release the memory, you can call different ISRs when the user needs, to meet a variety of different use requirements and keep a small memory overhead. §1.5.5 Program Example
This program (INTR.PAS) demonstrates the writing of the Statual Interrupt Routine (ISR) and demonstrates how to establish the evacuation method of the communication data area and the program, release all resident memory.
{$ M $ 1000, 0, 0} Program IntrRupt_example;
Uses dos;
Constmymark: String [8] = 'Myint500';
Varoldint5, Myintr5: Longint; Mark: String [10];
Procedure first; beginmark: = 'Myint500'; end;
Procedure Myint5 (Flags, CS, IP, AX, BX, CX, DX, Si, DI, DS, ES, BP: WORD); Interrupt; Beginline ($ FA); Myintr5: = MEML [0: 5 * 4]; Memw [0: 5 * 4]: = $ a; inline ($ fb); if Ax and $ ff00 = $ fe00 thenbegininline ($ fa); Meml [0: 4 * 5]: = Oldint5; reg.es: = Prefixseg; Reg.ah: = $ 49; msdos (reg); reg.es: = MEMW [prefixseg: $ 2c]; reg.ah: = $ 49; msdos (reg); inline ($ fb); endelsebeginwriteln ('Call Interrupt 5 '); Inline ($ FA); MEML [0: 5 * 4]: = MyIntr5; Inline ($ fb); end;
Procedure setInT5; BeginsetIntVec ($ 1B, SaveInt1b); Inline ($ FA); Oldint5: = MEML [0: 4 * 5]; setInetVec (5, @ myint5); MEM [Memw [0: 4 * 5 2]: $ a]: = $ cf; inline ($ fb); end;
Function Checkint5: Boolean; Vari, J: Word; INT5: Pointer; BegingeTintVec (5, INT5); Checkint5: = true; J: = OFS (Mark); for i: = 1 to 8 dobeginif (CHR (MEM [SEG) INT5 ^): <> mymark [i]) thnecheckint5: = false; end; end; procedure removeint5; beginif checkint5 kilinreg.ah: = $ f; Intr (5, REG); Writeln ('IntrRupt 5 HAS BEEN) Removed for memory '; endelsewriteln (' NOT FIND EXTERNAL IntrRupt 5 Routine '); END;
Beginfirst; if paramcount = 0 damimeginif checkint5 tellint5; halt (1); endelsebeginsetint5; keep (0); Endendelseif (paramstr (1) = 'r') or (paramstr (1) = 'R ') thenremoveint5; end.
§1.6 Dynamic array and their use
§1.6.1 Turbo Pascal Memory Allocation
Turbo Pascal divides the computer's available memory into 4 parts, as shown in Figure 1-2. The code segment is used to store compile program instructions; data segments are used to store constants and full variables of the program and units; the stack segments are used to store local variables in the program process and functions; the stack is used to store the dynamic variable of the program.
殌 ┌ - ─ ┐ ← Uploadable memory pose → │ Dynamic variable │ ↑ 向 上 上 上 上 上 上 上 上 → → → → → → → → → → → 段 段 段 → → 段 段 → 段 段 → → → → → → → → → → → → → → → → → → → → → → → → → → → → → → → → ─ ─ ┤ code segment → │ Program Directive │ └───── ┘ ← Minimum Available Memory 殣 Figure 1-2 Memory Allocation Chart of Turbo Pascal Program
The heap space is a dynamic data area controlled by the user, which is dynamically allocated by the pointer variable during the program. That is, the program does not assign space to the pointer variable when compiling, and when the program is run, the relevant statement is executed on the stack. Although the space of the heap can fluctuate between 0 to 640K, the volume of each dynamic variable established therein cannot be greater than 65521 bytes.
§ 1.6.2 Method for constructing a dynamic array
According to the management method of Turbo Pascal, an array of total volume is not more than 64K, can be allocated directly in the stack space, and construct a dynamic array in the program run. The steps to establish a dynamic array in the heap are as follows: 1. Array and their pointer types TypeInTarrptr = ^ INTARRAY; INTARRAY = array [1..100] OF INTEGER; 2. Pointer Description of the pointer variable VAR INTARR: INTARRPTR; 3 There is a new or getmem process to allocate memory space in the heap before the application of the Dynamic array, establish a dynamic array and their pointer values. Such as: GetMem (INTARR, SIZEOF (INTARR ^)); 4. Reference Dynamic array is used in the program in a general Turbo Pascal dynamic variable reference rule. Such as: Writeln (INTARR ^ [10]); 5. Release the memory dynamic array for use, immediately release the heap space with the Dispose or FreeMem process. Such as: FreeMem (INTARRPTR, SIZEOF (INTARR ^)); the following program demonstrates the above method, which establishes a realistic array A for 10,000 elements in the heap. Program dynamic_Array; typerr1 = array [1..10000] of real; var: ^ Arr1; I: integer; begingetmem (a, sizeof (a ^)); for i: = 1 to 10000 do a ^ [i]: = i; for i: = 1 to 10000 do Write (a ^ [i]: 8: 0); FreeMem (A, SizeOf (A ^)); End.§1.6.3 Constructs an array of greater than 64K
These subsets are created in the stacks when making several large numbers with a combination of less than 64K, a lower dimensional group. Then, the pointer of these sub-arrays is organized in the form of a pointer array. In form, the array name of the pointer array is the array name of the large array to be defined, and the elements of the array to be defined will be referred to each element of the array, thereby achieving the use of usual program habits in the expression. The purpose of an array element. The following program gives examples of examples of the above methods. It creates an 8x100 x100 three-dimensional digital A group A, about 480K memory. The array is regarded as composed of 8 100x100 two-dimensional sub-arrays because the volume of each sub-array is 60000 bytes, so it can be represented by a dynamic array. Pointing 8 pointers of these 8 sub-arrays constitute a pointer array A. This can be referenced by A [i] ^ [j, k], which does not require any subscript shift, and can directly participate in the calculation of the expression, and is very close to the usage of the static array. This guarantees the original programming style, which gives the procedure design, writing, reading, debugging and modification.
Program huge_Array; constn = 100; m = 8; Typearr2 = array [1..n, 1..n] of real; var: array [1..m] of ^ Arr2; I, J, K: Integer; Beginfor i: = 1 to m do getmem (a [i], sizeof (a [i] ^)); for i: = 1 to m dofor J: = 1 to n DOFOR K: = 1 to n DOA [i] ^ [J, K]: = 100 * i 10 * J K; for i: = 1 to m dobeginfor J: = 1 to n DobeGINWRITELN ('***** i =', i, ', j =' , J, '*****'); for K: = 1 to n DO WRITE (a [i] ^ [j, k]: 8: 0); Writeln; End; Writeln; End; for i: = M Downto 1 Do FreeMem (a [i], sizeof (a [i] ^)); END. § 1.6.4 Dynamic adjustable group implementation
When some array operation is performed multiple times in the program, such as matrix transposition, matrix multiplication or solving linear equation, programmers always want to write some array operation into a general process, so that arrays in the process are The modulation group, that is, the number of dimensions and elements types of array is fixed, and the upper and lower boundaries of each dimension can be changed. The implementation method of the dynamically adjustable group is as follows: 1. Type Description Establish an array type according to the desired array type, in order to achieve an array scale, it is not necessary to give the boundaries of each dimension of the group. Such as: type reaRray = array [1..1] of real; 2. Variable Description Dynamically adjustable array variables, the description of the dynamic array, using the form of a pointer. Such as: Var ra: ^ reaRray; 3. Dynamically adjustable group Establishment When you need to use an array, first calculate the value of the space according to all array elements, and then assign the Arraysize by the New or GetMem to allocate the accommodation of Arraysize bytes. The FillChar function fills this space into 0, which is created by completing the array. 4. The reference to the array is the same as the reference method of the dynamic array. 5. Undo of the array is to increase the utilization of the heap space. After the array should be canceled, the method is to use the Dispose or FreeMEM function to release the stacker space allocated to the dynamic array. The following program demonstrates the above method, first describing a two-dimensional array type, the boundaries of the array are u.; then explain a pointer variable with this type of group; start, require the user to enter the size of each two-dimensional number of two-dimensional array, then Calculate the size of the array, apply for a heap space, and then use the pointer variable utility array, and finally undo the array. Program Changable_Array; TypeArrayint2 = array [1..1, 1..1] of integer; varp: ^ arrayint2; arraysize: word; i, j, n, m: integer; beginwrite ('n ='); readln (n Write ('m ='); readln (m); arraysize: = n * m * sizeof (Integer); getMem (p, arraysize); Fillchar (p ^, arraysize, '0'); for i: = 1 to n DOFOR J: = 1 to m dobeginrandomize; p ^ [i, j]: = random (j); Write (i: 3, '', p ^ [i, j]: 5); end; freemem p, arraysize; end.
§1.7 expand memory
---------------------------------------------- you are a wind I am sand, the forum is my home
PS: "Sands" is my old ID, "water-wood sand": = "Snow people" newly registered a ID - Passbyword, or me. 2003-4-2 15:55:55 Sands Title: Webmaster Level: Administrator Prestige: 2 Articles: 927 Points: 1863 School: Anti-Japanese Union Registration: 2002-8-4
§1.7 Extended Memory (EMS) and Its Use
In order to break through the limitations of DOS management 640K free memory space, in 1985, Lotus / Intel and Microsoft jointly developed an extended memory specification, referred to as LIM-EMS. Its dominant thinking is to avoid the challenge of the CPU mode switching, using the "Storage Switch" technology that is quite mature on the hardware: Insert the extended memory card into the machine's expansion slot, the memory is in the normal addressing space of the CPU Outside; by establishing a specific mapping relationship is repositioned by the hardware to somewhere in the CPU addressing space, this mapping relationship can be freely changed in the DOS program to access the entire extension memory. This part of the memory space expanded with a bank switch technology is referred to as an expanded memory. The management of extended memory is provided by the extended memory management program EMM (Expanded Memory Manager), which is provided by INT 67H. EMM 3.2 supports maximum 8MB of EMS memory, and EMM 4.0 can support 16MB. EMS technology has been widely used in 8088/80286-based machines. Most of the excellent commercial software, such as spreadsheets, CADs, etc., support EMS specification. How to use EMS memory in applications written in Turbo Pascal? A generic Turbo Pascal can be designed with an EMS program unit (see §2.6), the application uses this program unit to use extended memory. Here is how to use EMS in the program.
§ 1.7.1 Extended memory works
A memory expansion card is required to use extended memory. This card is accessed by the Extended Memory Manager (EMM) software. When the computer is started, the extension memory management software is loaded, which needs to be specified in the config.sys file. The extended memory management software divides the memory on the extended memory card into 16K pages. This, 2M extension memory is equivalent to 128 extended memory pages, but these pages cannot be used at the same time. The number of extended memory pages that can be used is determined by the size of the page frame.
§1.7.2 Extended Memory Page
The 8088/86 microprocessor in the PC can address 1M bytes, commonly referred to as conventional memory. However, when starting the computer, DOS retains a lot of memory (384K), only for users to leave 640K. Extended Memory Manager divides 64K as an extended memory page in the 384k of DOS. The page frame is like an extension memory window. This window has 4 16K "window slices", each of which extends memory. Before using a page extension memory, you should move the page or move it to the page box. For example, if you want to store some information in the 0 page of the extended memory, you should shoot 0 pages into the page box and move the data into the page box. When a program is to use more extended memory, you need to move some new pages into the page box. When you shoot a page into the page box, the original page in the page box is to be imaged, that is, to be saved in the extended memory. When it moves back to the page box later, the information is the same as before.
§1.7.3 Logic page and physical page
Two frequently occurring terms associated with extended memory are physical pages and logic pages. The physical page is 4 pages of the formation page frame, and its number is 0 to 3. The logical page is an extended memory page that is imaged in the page box. The page in the page box is "physics" because you can store data directly in the page box, but you cannot pass data directly to the page of the extended memory. §1.7.4 Extended memory handle
Call the extended memory manager for allocation before using an extension memory page. You can apply at least 1 page, all available page. When the extended memory manager meets the application allocation page, return an extended memory handle, which is an integer associated with the assigned page. Each handle has its own extended memory page. For example, the handle can be assigned 3 pages, numbered 0 to 2. At the same time, another handle may have 5 pages, numbered 0 to 4.
§1.7.5 Extended memory function
Using extended memory functions is the same as using DOS and BIOS interrupt service. The extended memory management software takes an interrupt 67h when loading memory. All expansion memory services are completed by this interrupt. The expansion memory manager has been modified, and its latest version is version 4.0, which provides 30 extended memory services, only 15 of which work in the old version. In these 15, there are only a few a few of the most expanded memory programs. Table 1-3 lists the most common expansion memory services.
Table 1-3. The most common expansion memory service 殔 ┌ - ─ ───────────────────────────── ─ ─ ─ ─ ─ │ Description │ Description │├─────────────────────────────────── ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ │ Determines whether expanded memory management procedures and │ │ │ │ Normal work. The result is returned in the AH register, ││ │ │ 0 indicates that the EMM is installed and the hardware ││ │ │ │ │ 41H │ Take the page address │ Take the page segment address in BX. If AH is not equal to ││ │ │ 0, the value in BX ││ 42H │ Take the number of unallocated pages │ get the number of extended memory in the computer (in DX ││ │ │) and program available pages (in BX) ││ 43H │ Assignment Memory │ Notify EMM Program Allocation Extension Instructions for User Creation ││ │ │ Preface. BX places you needed. EMM ││ │ │ Disconnect the handle in DX. ││ 44H │ Import Memory │ Transmit an extended memory page (BX specified) to a ││ │ │ page box (specified by Al). EMM page clause ││ │ │ handle is specified by DX ││ 45H │ Release Memory │ Release all of the page of an EMM handle (DX specified). ││ │ │ Once released, these pages can be reassigned to a ││ │ │ new handle. ││ 46H │ Take EMM Version │ Return to the current EMM version. When returned, ││ │ │ 高 4 is the primary version number, low 4 is the version of small ││ │ │ number part. │ └ - ┴────────────────────── ─ ─ ─ ┘ §1.7.6 Judging whether the extended memory is installed
Extend memory service 40h, the report is loaded with the extended memory manager and whether the hardware function is normal. Users may use this feature to determine if the running computer has an extended memory installed, but this is wrong, because only 40H service can be used after the extension memory manager is installed. If you use a 40H service program without extending memory, the computer may die. So what is the 40H service? And how do you know if the expansion memory is installed in your computer? The first question is simple, and you want to detect whether the extended memory is working properly. The 40h service can provide this periodic state report. The 35H function of DOS is used to take an entry address of an interrupt program, call it to determine if the extended memory is installed. The service program returns the segment address (ES) and offset address (BX) of the interrupt service program that specifies the interrupt. Because EMM uses interrupt 67h, this DOS call returns an EMM entry address if EMM is installed. If an extended memory management program (EMM) is loaded, a fixed address in memory is stored in memory - "emmxxxxx0". This address is the EMM, and the offset is 0ah. DOS Service 35h Returns the EMM segment address in ES, offset in BX. Look at the content at the memory ES: 000AH, you can judge whether EMM is installed. If ES: 000AH is a string "emmxxxxx0", then EMM is installed, otherwise this management software is not installed. Detecting whether the blocks of EMM exist are as follows:; Detecting EMM exists; MOV AX, 3567HINT 21HMOV DI, 10PUSH CSPOP DSMOV SI, OFFSET Devnamemov CX, 8Rep Cmpsb; Devname DB 'Emmxxxx0';
§1.8 Expansion Memory (XMS) and Its Use
EMS technology has been widely used on the 8088/80286 machine, but there is almost no 386 machine will expand the memory card, because the 386 chip is different from 286, its memory management is more powerful, mode switch is also very convenient Its page management feature can easily map memory to any address; another 386 data bus is 32 bits, 32-bit memory cards are more fast than 16-bit EMS cards, and it is cheap; therefore at 386 It is very popular among the software by software using the expansion memory (XMS) emulation (EMS). Extended Memory refers to the partial memory located above 1MB (100000h), which is only available on a machine equipped with 80286 above CPUs. If the application uses expansion memory, not only is fast, but also high efficiency. Typically, in the 80386 and 80486 systems, MS-DOS also provides an EMM386.EXE program that enables the expansion memory simulation to extend memory. In MS-DOS 4.0 and Windows 3.0, an Extended Memory Manager named HIMEM.SYS is provided, which is prepared according to the expansion memory management specification 2.0 version of Lotus / Intel / Microsoft / AST. Make the application to expand the use of memory. Himem.sys is a device driver that can be described in the system configuration file (config.sys) with the device command, which can be loaded when the machine is started. XMS uses the use of 43H sub function by int 2fh. The XMS management function and usage methods are specifically described below.
§ 1.8.1 Expansion Memory Management Specification (XMS) Introduction
Expansion Memory Management Specifications (XMS) is a collaborative results of Lotus / Intel / Microsoft / AST. It defines a software interface for 286/386 microcomputers, allowing the real mode program to expand memory in a manner that is unrelated to hardware. If the procedures developed by different vendors apply for expansion memory according to this protocol, then they can share peace between them and no conflicts. The XMS specification defines the application, modification, and release function of 3 memory blocks:. The upper memory block (UMB): The address is between 640k and 1024K. High Internal Region (HMA): The address is between 1024K and 1088K. Expand the memory block (EMB): The relationship between the address is in 1088k or more is shown in Figure 1-3.殌 ─────────────16MB / 4GB │EMB (expansion memory block) │ Expand memory ├─────────────────────── 64kb ↓ │HMA (high internal memory) │────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────── ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─┤│ │EMS traditional memory page frame address │├────────┤ address │├────────┤│ │ │ peripheral port video refresh buffer ││ ├──── ─ ─ ─ ┤640kb│ │ General Memory ││ │ ---------------- │ ↓ │ MS DOS Nuclear │ ─────────────── 0kb 殣 Figure 1-3 286/386/486 memory image map
So the expansion memory refers to memory outside the 80x86 machine 1MB addressing space. In the expanded memory specification, the expansion memory also refers to the high memory area (HMA) and the upper memory block (UMB). UMB refers to memory between 640KB and 1MB of DOS memory. Before DOS5.0, programmers can only use this zone through the XMS driver, starting from DOS 5.0, can access UMB through the DOS memory service. In fact, the DOS memory service routines have accessed the XMS driver. There is also a special HMA. When the CPU is running in real mode and the 21st address line (A20) is in an active state, the CPU can access a 65520B of memory (64K less 16b), which is called HMA. The presence of HMA is related to the addressing method of the CPU. The CPU is addressed according to the segment address: the offset address is addressed, first multiplied the segment address by 16, plus the offset address to form a physical address. If this value exceeds 20, it cuts its high position, so that the physical address is between 000000H-0FFFFH. If the A20 line does not activate, the address 0FFFF: 0010h is the physical address 000000h; if the A20 line is activated, 0FFF: 0010h is the physical address 0100000: 0000h, which has additional 65520B memory. That is, the address 0FFFF: 0010H-0FFFF: 0FFFFH is usually mapped to the physical address 000000h-00ffffh, when A20 is activated, the image arrive is 010000H-010ffEfh. The XMS driver provides five sets of functions: driver information, HMA management, A20 address line management, expansion memory management, and upper memory block management. Another two functions are to check if the XMS driver exists and the address of the XMS driver control function. Table 1-4 gives an XMS function call.
§1.8.2 XMS use
Using expansion memory, it is necessary to determine if the expansion memory is available. First, the following code is executed, it is determined whether the XMS program exists. MOV AX, 4300HINT 2FHCMP AL, 80HJNE XMS_NOTPRESENT; XMS is present If there is, the address of the XMS driver control function is used to complete this function with the following code segment. XMS_CONTROL DD (?); MOV AX, 4310HINT 2FHMOV WORD PTR [XMS_Control], BXMOV WORD PTR [XMS_CONTROL], ES;, the XMM can be used to use the XMM. If the program performs the EMM version number is as follows:; MOV AH, 0Call XMS_Control; Table 1-4. The function call of the table 1-4.xms 殔 殔 殔 殔 殔 殔 殔 殔 殔 殔 殔 殔 殔 殔 殔 殔 殔 殔 ┌ 殔 殔 殔 ┌ - ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ┐│Function │ Function number │ Description │├──────────────────────── ─ │ Driver Information │ 0 │ Take XMS Release Number │├─── ─ ┼───────────── ─ ┤│Hewei HMA │ 1 │ Request High Memory Zone HMA ││ │ │ 2 │ Release High Memory HMA │├──────── ─ ┼──────────── ─ ┤│Inditative │ 3 │ Full-journey A20 │││ │ │ Full Deactivation A20 ││ A20 │ 5 │ Local Enable A20 ││ │ 6 │ Local stop Use A20 ││ ∎ Address │ 7 │ Query A20 status │├──────────────────────────────────────────────────────────────────────────────────────── 1. Take the version number entry parameter: AH = 00H Exit parameters: AX = binary version number; bx = internal XMM version; DX = 1, there is HMA2. Request high storage area (HMA) entry parameters: AH = 01H; DX = Request Length outlet parameters: ax = 1, HMA allocation success; otherwise the BL returns an error code, the error code is shown in Table 1-53. Release the high storage area (HMA) entry parameters: AH = 02H Exit parameters: AX = 1, HMA release success; Otherwise, BL returns an error code 4. Open the A20 entry parameter: AH = 03H Exit parameters: AX = 1, A20 is activated; otherwise the BL returns an error code 5. Full Close the A20 entry parameter: AH = 04h Exit parameters: AX = 1, The A20 is closed; otherwise the BL returns an error code 6. Local open A20 entry parameters: AH = 05H Exit parameters: AX = 1, A20 is activated; otherwise the BL returns an error code 7. Local shut down A20 entry parameters: AH = 06h Exit parameters: AX = 1, A20 is closed; otherwise the BL returns an error code 8. Query A20 state portfolio: AH = 07h Exit parameters: AX = 1, A20 has been activated 9. Queries Freely Expand Memory size Entrance parameters: AH = 08H Exit Parameters: AX = maximum expansion memory block length (KB), DX = free expansion memory total number (KB), BL = error code This is the total number of expansion memory in the system is subtracted to minus HMA's memory number. 10. Assign the expansion memory block entry parameter: AH = 09H Exit parameters: ax = 1, allocation success; DX = expand the memory block handle; BL = error code expansion memory management is achieved by expanding the memory control block, expand the memory control block The data structure is as follows: DB flag (01: free block; 02: Distribution block; 04 idle block) DW Memory block site (KB) DB lock flag (0: lock; non-0: unlock) DW memory block length ( KB) The address of the expansion memory control block is referred to as an expansion memory block handle. As can be seen from the data structure, the most basic management unit of the expansion memory is 1kb, which is 128MB of the maximum accessible physical address. The number of expansion memory control blocks is that the number of handles can be explained in the system configuration file. The default value is 21, the maximum value is 128, that is, the most used memory block is 128. 11. Release the expansion memory block entry parameter: AH = 0AH, DX = Exchange memory block handle outlet parameters: ax = 1, the expansion memory block is released; otherwise the BL = error code 12. Move expansion memory block entry parameters: AH = 0bh, DS: Si = Parameter Table Address Export Parameters: AX = 1, Successful Movement; BL = Errors This function can be bidwardly transmitted between regular memory and expansion memory. DS: Si's parameter table format: DD transmission length (must be an even number) DW Target block handle DW source handle DD target block The offset DD source block is shifted in which the corresponding offset is The amount is represented in the form of segment: offset, and the data is returned by the BL. 13. Expansion memory block locking entry parameters: AH = 0CH; DX = handle Outlet parameters: ax = 1, lock success; dx: bx = 32-bit lock memory address; otherwise, BL = error code 14. Expand memory block Unlocking entrance parameters: AH = 0dH; DX = handle Exit Parameters: ax = 1, unlock success; otherwise, BL = error code 15. Take the expansion memory control block handle information entry parameter: AH = 0EH; DX = handle Outlet parameters: AX = 1, the information block has been obtained; BH = lock information; BL = free handle number; DX = memory block length (kb); otherwise the BL = error code 16. Re-allocate the expansion memory entry parameter: AH = 0FH; DX = handle; BX = new length (KB) Export parameters: ax = 1, redistribution success; otherwise BL = error code table 1-5.xmm error code list 殔殔━━┯┯━━━━━━━━━━┯┯┯┯┯┯━ ┳┳┳┯┯┯━━━━━━━━━━━━┓┓┓ 错 错 错 错 │ Meaning error code │ meaning ┠ - ┼─────────────────────────────────────────── ─ ┼──────────────────────────────────X 01H │ HMA has been used │United virtual disk 92H │ request length less than minimum request length A20 address line processing wrong 93H │ hma unuse 用 用 │ General driver error A0H │ 无 自 扩 内 内 │ No HMA A1H │ Non-expanded memory handle available │ Expansion Memory Control Block Handle Invalid │ 地址 地址 地址 地址 地址 地址 地址 无 无 无 无 无 无│ Memory block has been closed │ Plock memory block number has spilled 无 无 无 │ │ │ 无 无 无 无 ┗ ┗ ┗ ┗ ━━━━━━━┻┻┻┷┷┷━━━━━━━ 标准━━┛ 殣 殣 § 1.9 Program standard data code processing method Many programs are to read some standard data files in memory when they start running. These data files contain some constant information, such as a font base and a special table. Turbo Pascal Using Program BinoBJ enables users to put these data directly in the program, avoid reading when the program is running. Use binobj to put the data loader for 3 steps:. Create a data file; use binobj to convert the data file to .obj file;. Data file is referenced in the program. Treating data files as an external process, becoming a part of the program, can automatically load memory when the program is started. This has the following advantages: First, due to the need to open and read the file, speed up the program running speed; secondly, if the program is sold as a commodity, the number of disk files can be reduced; the third, the programs are added to the program. § 1.9.1 Create a data file Before using binobj, there must be a binary data file ready. The following procedure produces a binary data file containing 1 to 100 and its natural logarithm. The structure of the file is defined by the array type LOGARRAY. Program MakeBinaryDataFile; TypeLogArrayPtr = ^ LogArray; LogArray = Array [1..100] of RecordI: Integer; LnI: Real; End; VarI: Integer; LogA: LogArrayPtr; F: File of LogArray; beginGetMem (LogA, sizeof (LogA ^ )); for i: = 1 to 100 dobeginloga ^ [i] .i: = i; loga ^ [i] .lni: = ln (i); end; assign (f, 'logdata.bin "); REWRITE f); Write (f, loga ^); Close (f); end. The logData.bin binary data file generated by the program can be used as a binoBJ input file, which has a logArray type, so access these as an external When the data of the process, the same data type must be used. §1.9.2 Conversion Data File Convert binary data files to target files (.Obj) with binoBJ. The general format using binobj is: binobj § 1.9.3 Accessing external processes After converting the generated data file into the target file, you can connect to the program. The general form of implementation is: Procedure Beginloga: = @logdat; for i: = 1 to 100 dobeginwrite (loga ^ [i] .i); WriteLn (loga ^ [i] .lni: 10: 4); end; end.loga is with the data created The file has the same data type of pointer variable. At runtime, loga points to the connected data through this statement: loga: = @logdat; This statement removes the address of the logDat and assigns Loga. This allows all the data in LOGA, just like dynamically allocated in the stack. Note that loga does not apply for any memory because it is in the code segment. Do not attempt to release LOGA or any other pointer to code segments. Although it is a valid method that stores data in code using binoBJ, it also has some drawbacks. Assume that the data is stored in the code segment of the program. If the data file is large, the code will exceed 64K limit, and the data will be saved in memory after the program is started, and cannot be released as the application space on the pile. In addition, if you modify a data file, you must re-run binobj and compile the program. ---------------------------------------------- you are a wind I am sand, the forum is my home PS: "Sands" is my old ID, "water-wood sand": = "Snow people" newly registered a ID - Passbyword, or me. 2003-4-2 15:56:22 Sands Title: Webmaster Level: Manager Prestige: 2 Articles: 927 Points: 1863 School: Renewal: 2002-8-4 7th floor The second chapter of the practical tool unit accumulates many practical Pascal processes and functions during long-term use of Turbo Pascal, and merges into several Turbo Pascal program units, most of which are mixed with Turbo Pascal and Turbo. There is a high practical value, and it has the role of learning Turbo Pascal programming technology, which is now dedicated to the majority of readers. These program units include: screen input / output unit ACRT, string processing unit ASRT, disk input / hotkey unit POPUP, database interaction unit DBASE, extended memory usage unit EMS, expansion memory usage unit XMS, mathematical functions Unit Math, Matrix Computing Unit Matrix, Probability Distribution Unit PROB and COMPLEX. These units are suitable for various Turbo Pascal versions of Turbo Pascal 4.0 and above. The assembler can be rewritten as an embedded compilation for the readers of Turbo Pascal 6.0, which provides independent TURBO compilation. Source program. The reader can use these units directly to use it, or the modification can be extended as needed, and can learn the method, process or function of the DOS interrupt routine, process or function, etc. Advanced usage. §2.1 Screen Input Output Unit ACRT The screen input / output unit is a collection of some processes and functions related to the display, including 12 processes and functions such as setting cursor size, setting, and acquisition display, setting, and acquisition display modality, open, and turn off the electronic clock, it is Extension and complement of Turbo Pascal's CRT unit. Part of the ACRT unit is written in Turbo Assembler, which is in acrt.as, and the rest of the code in acrt.PAS, the assembler can use TASM's various versions of the target (.Obj) for Turbo Pascal compiler. use. The use of 12 processes and functions of the ACRT unit will be described below. §2.1.1 ACRT functions and processes 1. CRTTYPE Function Function Returns the Type of Computer Display Usage CrtType Result Type Character Type Return Value 'M' Represents Monochrome Display, 'C' Represents Color Display 2.SetCursor Process Function Sets the size of the cursor SETCURSOR (T: byte) Description T is byte value ginseng, can take 0, 1, 2 three values, t = 0 time slot disappears, T = 1 is a small cursor, T = 2 is a big cursor. 3.SetCrtMode Process Function Sets the display to a different display mode, such as text or graphics usage setCrtMode (i: byte) Description I can take various modes of display that can be identified, MDA is 7, CGA is 0-6, EGA 0-16, VGA is 0-19, such as Appendix 2. Use this process to display Chinese characters on the screen while using CRT! 4. GetCrtMode Function Get Display Modal Value GetCrtMode Result Type byte Type The presentation of the display of the display, see Appendix 2. Return value returns the display mode value 5.SetvPage Process Function Setting a display page for the current display page Setvpage (i: byte), Ming I can take the card acceptable value, the CGA is 0-1, the EGA and VGA are 0-3 6.Getvpage function function Gets the current display page number GetVpage result Type byte type return value Return the display page number value 7. OpenClock process function Displays an electronic clock method OpenClock in the upper right corner of the screen, indicating that the text shows the value of 0-255. 8.Closeclock process function Close the electronic clock method of the upper right corner of the screen CloseClock 9.Writexy Process Functions Specify the location on the screen WRITEXY (X, Y, Ta: Word; S: String) Description x is the line value, y is the column value, TA is text properties, s For the string to be displayed 10.Yesno function function Proves to the user (YES, NO) problem | YESNO (S: String) Result Type Boolean Speech S Representation Question Content Strings Return Value True or False 11. LargeChar Process Function Displays an enlarged character usage LARGECHAR (X, Y, CH, BC, FC: Integer) Description X is the screen line value, Y screen column value, CH as ASCII code value of the character to be displayed, BC For the screen background, FC is the screen foreground color 12.Reboot process function restarts computer usage reboot 2.1.2 Use of ACRT AcrtDemo.Pas demonstrates the usage of partial processes and functions in ACRT. Procedure CLOCKDEMO demonstrates the use of two electronic clocks. VPAGEDEMO demonstrates the usage of setting the display page process, DISPLAYLARGECHAR demonstrates the usage of large ASCII character processes on the screen. §2.1.3 List of Source Procedures Program 1: acrt.pas {*******************************************} {unit: acrt} { Advanced Crt Interface Unit} {Written By Dong ZHANSHAN} {Version: June 1994} {******************************************* Unit acrt; {$ D-, S-} Interface Uses CRT; function CrtType: Char; procedure OpenClock (TA: byte); {Display a clock on screen} procedure CloseClock; {Remove the clock} procedure SetCursor (t: byte); {Set current cursor routine} procedure SetVPage (i: byte); Function GetVpage: Byte; Procedure SetCRTMODE (I: Byte); Function GetCrtMode: Byte; Procedure Largecha (X, Y, CH, BC, FC: Integer; Procedure Writexy (x, y, ta: word; s: string); Function YESNO (S: String): Boolean; Procedure Reboot; Inline ($ EA / $ 00 / $ 0000}); {JMP fff: 0000} IMPLEMENTATION {$ L acrt} Function CrtType; External {acrt}; Procedure OpenClock (TA: BYTE); External {acrt}; PROCEDURE closeclock; external {acrt}; PROCEDURE setcursor; external {acrt}; PROCEDURE setvpage; external {acrt}; Function getVpage; external {acrt}; PROCEDURE setCRTMODE; exTern {acrt}; Function getCRTMODE; EXTERNAL {acrt}; Procedure lard; type romchar = 219; type romchar = array [1..8] of byte; var chartable: array [0..255] of romchar absolute $ f000: $ fa6e; i, j, ildattr: integer; Pattern: Romchar; beginoldattr: = textttr: = bc * 16 fc; pattern: = chartable [ch]; for i: = 1 to 8 DOFOR J: = 7 Downto 0 dobegingotoxy (x-1 8-j, y- 1 i); if (ODD (Pattern [i] SHR J)) The Write (CHR (USEDchar)); end; TexttTr: = Oldattr; end; Procedure Writexy; BegingToxy (x, y); TexttTr: = Ta; Write (s); END; Function YESNO (S: String): Boolean; Var Ch: char; str: string [1]; beginstr: = '; yesno: = false; write (s,' (y / n)? '); Readln (STR) ); CH: = STR [1]; if ch in ['y', 'y']. Program 2: acrt.asm; acrt.asm; assembler incline file for acrt.pas unit Title acrtlocals @@ dosseg.model tpascal.codeassume cs: @code Procedure setvpage; Public setvpage Setvpage: Push BPMOV BP, SPMOV AX, [BP 6] MOV AH, 5INT 10HPOP BPRETF 2 Function GetVpage; Public GetVpage GetVpage: MOV AX, 40HPUSH AXPOP ESMOV Al, Byte Ptr ES: [62H] MOV AH, 00RETF Procedure setCRTMODE; Public setCRTMODE SetCRTMODE: Push BPMOV BP, SPMOV Al, [BP 6] MOV AH, 0INT 10HPOP BPRETF 2 Function getCRTMODE; Public GetCrtMode GetCrtMode: MOV AX, 40HPUSH AXPOP ESMOV Al, Byte Ptr ES: [49h] MOV AH, 00RETF Function CrtType: Byte; Public CrtType CrtType: MOV AX, 40HPUSH AXPOP ESCMP BYTE PTR ES: [49H], 7JZ @@ 1mov Al, 'C'; Colorjmp @@ 2 @@ 1: MOV Al, 'M'; Monochrome @@ 2: Mov Ah, 00Retf Procedure setCursor (T: byte); T = 0 no cursor; t = 1 small cursor; t = 2 Big Cursor Public setCursor SetCursor: Push BPMOV BP, SPMOV AX, 40HPUSH AXPOP ESMOV BX, [BP 6] CMP BYTE PTR ES: [49H], 7JE @@ 1cmp BL, 02JE @@ 2cmp @@ 6 @@ 1: cmp BL, 02JE @@ 4cmp BL, 01JE @@ 3 @@ 6: MOV CX, 2000HJMP @@ 7 @@ 3: MOV CX, 0001HJMP @@ 7 @@ 2: MOV CX, 0007HJMP @@ 7 @@ 4: MOV CX, 000CH @@ 7: MOV ES: [60H], CXPOP BPRETF 2 ; Int 1ch INT1C: Push ESPUSH DSPUSH DXPUSH CXPUSH AXJMP @@ 3 OS DB 00HTA DB 79H @@ 3: MOV AH, 02INT 1AH MOV Al, DHCall Bcd2Decasciicmp CS: OS, Alje @@ 2push AXMOV AX, 40HPUSH AXPOP ESMOV AX, 0B000HCMP BYTE PTR ES: [49H], 7 JE @@ 1MOV AX, 0B800H @@ 1 : MOV DS, AXPOP AXMOV DL, CS: Tamov CS: OS, Almov Byte Ptr DS: [159], DLMOV BYTE PTR DS: [158], Almov Byte Ptr DS: [157], DLMOV BYTE PTR DS: [156] Ahmov Al, Clcall Byte Ptr DS: [155], DLMOV BYTE PTR DS: [154], ':' MOV BYTE PTR DS: [153], DLMOV BYTE PTR DS: [152], Almov BYTE PTR DS: [ 151], DLMOV BYTE PTR DS: [150], AHMOV Al, Chcall Bcd2decasciimov Byte Ptr DS: [149], DLMOV BYTE PTR DS: [148], ':' MOV BYTE PTR DS: [147], DLMOV BYTE PTR DS : [146], Almov Byte Ptr DS: [145], DLMOV BYTE PTR DS: [144], AH @@ 2: Pop Axpop CXPOP DXPOP DSPOP ESIRET; Translate BCD Code To Decimal ASCII Code; in Al BCD Code; OUT AX Decimal ASCII Code BCD2DECASCII: Push Cxmov Ch, Aland Ch, 0fhmov Ah, Chadd Ah, 30HMOV CL, 4SHR Al, Cladd Al, 30HXCHG AH, Alpop Cxret Procedure OpenClock (TA: BYTE) ;; Procedure CloseClock; Public OpenClockPublic CloseClock INT1CSEG DW 0000HINT1COFFSET DW 0000H OpenClock: Push BPMOV BP, Spmov CX, [BP 6] MOV CS: TA, CLSUB AX, AXMOV ES, AXMOV AX, ES: INT1COFFSET, AXMOV AX, ES: [72H] MOV CS: INT1CSEG AXMOV AX, OFFSET INT1CMOV BX, SEG INT1CCLIMOV ES: [70H], AXMOV ES: [72H], BXSTIPOP BPRETF 2 CloseClock: Sub AX, AXMOV ES, AXMOV AX, CS: INT1COFFSETCMP AX, 0000HJE @@ 1climov ES: [70H], AXMOV AX, CS: INT1CSEGMOV ES: [72H], Axsti @@ 1: Retf End Program 3: acrtdemo.pas {---------------------------------} {acrtdemo.pas} {DEMONSTRATESTRATES THE usage of acrt} {Written by dong zhanshan} {version: june 1994} {------------------------------------------------------------------------------------------------------ ---} Program acrtdemo; Uses CRT, ACRT; Procedure ClockDemo (DISP: BOOLEAN); Beginif Disp Then OpenClock (12) else closeclock; Procedure vPageDemo; var i: integer; beginfor i: = 1 to 3 dobeginsetvpage (i); delay (2000); end; setvpage (0); Procedure DisplayLarge; Var i, J: Integer; BeginFor i: = 1 to 4 dobeginclrscr; Writeln (i); LargeChar (10, 10, 65, 1, 10 i * 2); LargeChar (20, 10, 66, 1 14 i * 2); LargeChar (30, 10, 67, 1, 15 i * 2); for j: = 1 to $ 1000 Domove (MEM [$ B800: J], MEM [$ B800 i * $ 100 : J], 1); End; end; Beginclrscr; ClockDemo (True); DisplayLargechar; VPageDemo; ClockDemo (false); CLRSCR; END. §2.2 String Processing Unit ASTR String Processing Unit Astr is a collection of processes and functions related to strings, including hexadecimal numeric strings, filling strings, digital strings, date, and time string, generating space string, character Size of string and the like. It is a useful supplement for Turbo Pascal string. The ASTR unit is mixed with Turbo Pascal and Turbo, and the code is stored in Astr.Pas and Astr.asm, astr.asm can use TASM as a target file (.Obj) for Turbo Pascal compiler. The function and calling method of 10 functions are described below. §2.2.1 ASTR function and process 1. HEXSTR function function converts the content of the given variable into hexadecimal string usage hexStr (var num; Bytecount: Byte) result Type String Type Description NUM For the variable to be converted into a hex string, it can be Byte integer, word type integer, symbol integer, long integer, character, string, etc. Bytecount is the number of bytes of the variable to be converted. Return value hexadecimal string 2. FillChartostr function function Press the specified character to fill the specified length of the specified length FillChartostr (LEN: BYTE; CH: CHAR) result Type String Type Description LEN is the length of the string; CH is the specified character of the specified character returns a specified character. String 3.wordTOSTR function function Converts a given font integer to the specified length character string WordTostr (Num: Word; Len: Byte) result Type String Type Description Num is a character integer; LEN is a string to be generated Length return value Specifies the length of the word integer string 4.intTostr function function Converts a given integer to character string INTOSTOSTR (Num: Integer; Len: Byte) result Type String Type Description Num is integrated; LEN is a string to be generated Length return value Specifies the integer string of length 5. Real digital string function RealTostr function Converts a given real shape to a character string for a specified format RealTostr (Num: Real; Len, Places: Byte) Result Type String Type Description Num is real number; LEN For the length of the string to be generated; Places is specified in the format of the real -meter real number string for the decimal number return value. 6.DateSTR function function Generates the character string of the current date DateSTR result Type string Type Return Value The current date string, format is "Sunday July 17, 1994" 7.TimeStr function function Generates the character string of the current time TimeStr result Type string Type Return to the current time string, format is "2:20 pm" 8. Space function function Generates a space for a specified length Space (LEN: BYTE) Result Type String Type Description LEN LEN String 9.upPerstr function function for the length of the length of the string to generate strings 9.upPerstr function function String Convert to uppercase string UPPERSTR (var s: string) Result Type String Type Description S is the source string, the variable return value uppercase string 10.Lowerstr function function Converts a given string to lowercase string Lowerstr (var s: string) Result Type string Type Siy Source string, variable returns a string of lowercase §2.2.2 ASTR's use AstrDemo.Pas demonstrates the usage of partial processes and functions in Astr. UPLOWDEMO demonstrates the usage of the Upperstr and Lowerstr functions. It converts 26 uppercase letters to the corresponding lowercase letters, and HexStrDemo demonstrates the usage of the HexStr function. It automatically generates a total of decimal and hexadecimal strings of the ASCII code complete works, and display it. On the screen, DateTimedemo demonstrates the DateStr and TimeStr functions to display the current date and time to the screen in an intuitive form. §2.2.3 List of Source Procedures Procedure 1: astr.pas {************************************************************************ Unit: astr} {advanced string interface unit} {Written by dong zhanshan} {version: june 1994} {********************************************* *************} Unit astr; {$ D-, S-} Interface Uses dos; Function HexStr (VAR Num; Bytecount: Byte): String; Function Fillchartostr (LEN: BYTE; CH: CHAR): String; Function Wordtostr (Num: Word; Len: Byte): String; Function INTOSTR (Num: integer; len: BYTE): String; Function Realtostr (Num: Real; Len, Places: Byte): String; Function DateStr: String; Function TimeStr: String; Function Space (LEN: BYTE): String; Function Upperstr (s: string): string Function Lowerstr (S: String): String; IMPLEMENTATION {$ L askR.Obj} Function HexStr; External; {astr} Function Upperstr (s: string): string; external; Function Lowerstr (S: String): String; External; Function FillChartostr; Vars: String; Begins [0]: = Chr (LEN); Fillchar (S [1], LEN, CH); FillChartostr: = S; END; Function space; beginspace: = FillChartostr (len, ''); Function Wordtostr; Vars: String [5]; Beginstr (Num: LEN, S); Wordtostr: = S; end; {WordTostr} Function INTSTR; VARS: STRING [5]; Beginstr: = S; end; {INTOSTR} Function RealToStr; VARS: String [80]; Beginstr (Num: Len: Places, s); Realtostr: = s; end; {realtostring} Function daters = array [0..6] of string [9]; months = array [1..12] of string [9]; constdaynames: weekdays = ('sunday', 'monday', 'tuesday ", 'Wednesday', 'Thursday', 'Friday', 'Saturday'); MONTHNAMES: MONTHS = ('January', 'February', 'March', 'April', 'May', 'June', 'July', 'August', 'September', 'DECEMBER', 'DECEMBER'); BlankStr: String [1] = '; Commastr: String [1] =', '; VArseofweek: Word; Year, Month, Day: Word; Yearstr: String [4]; DayStr: String [2]; Begingetd; Str (Year: 4, Yearstr); Str (DAY, daySTR); DateStr: = daynames Dayofweek] Blankstr Monthnames [Month] Blankstr DayStr Commastr Blankstr YearsTrend; Function TimeStr; TypeAmpm = array [0..1] of string [3]; constampmstr: ampm = ('am', 'pm'); colon: string [1] = '; VARTMPHOURS, TMPMINS: Word; Hourstr , Minstr: String [2]; AMINDEX: Word; Hours: Word; Begingettime (Hours, Minutes, Seconds, Tics); TMPHOURS: = Hours; tmpmins: = minutes; if (Seconds> 30) Thenbegintmpmins : = SUCC (TMPMINS) MOD 60; IF (Tmpmins = 0) THENTMPHOURS: = SUCC (TMPHOURS) MOD 24nd; IF (TMPHOURS <12) ThenbeginAmindex: = 0; if (TMPHOURS = 0) THENTMPHOURS: = 12ENDELSEBEGINAMINDEX: = 1; IF (TMPHOURS> 12) THENTMPHOURS: = TMPHOURS - 12END; STR (Tmpmins: 2, minStr); if (Tmpmins <10) THENSTR [1]: = '0'; STR (TMPHOURS, Hourstr); TIMESTR: = Hourstr COLON MINSTR AMPMSTR [AMINDEX] END; END. Procedure 2: astr.asm; astr.asm (Turbo Assembler Program); assembler incrude file for asse.pas unit; writen by dong zhanshanin 1994 Title astrlocals @@ Dosseg.model tpascal.codessume cs: @code Parameters ( 2 Because of Push BP) Bytecount EQU BYTE PTR SS: [BP 6] Num EQU DWORD PTR SS: [BP 8] Function Result Address ( 2 Because of Push BP) Resultptr Equ DWORD PTR SS: [BP 12] Public hexstr HexStr: push bpmov bp, sp; get pointer into stackles di, resultPtr; get address of function resultmov dx, ds; save Turbo's DS in DXlds si, num; get number addressmov al, byteCount; how many bytes xor ah, ah;? Make a Wordmov CX, AX; Keep Track of Bytes in CXADD SI, AX; Start from MS Byte of Numberdec Sishl AX, 1; How Many Digits? (2 / Byte) CLD; Store # Digctions (Going Forward) stosb; in Destination string's length byteHexLoop: std; scan number from MSB to LSBlodsb; get next bytemov ah, al; save itshr al, 1; extract high nibbleshr al, 1shr al, 1shr al, 1add al, 90h; special hex conversion sequencedaa; using ADDs and DAA'sadc al, 40hdaa; nibble now converted to ASCIIcld; store ASCII going upstosbmov al, ah; repeat conversion for low nibbleand al, 0Fhadd al, 90hdaaadc al, 40hdaastosbloop HexLoop; keep going until donemov ds, dx; restore Turbo's DSpop bpretf 6 Parameters Take 6 bytes; function upperstr Public Upperstr RESSTR EQU DWORD PTR [BP 10] S EQU DWORD PTR [BP 6] Upperstr: Push BP; Save BPMOV BP, Sp; Save Up Stack Framepush DS; Save Dsxor Ch, Chmov BX, Offset Smov Cl, Byte Ptr [BX] JCXZ @@ 4inc CLLDS SI, S; Load String Addressles Di, RESSTR; LOAD result addresscld; Forward string-ups @@ 3: lodsb; Load a characterstosb; Copy a characterloop @@ 3; Loop for all characterspush espop dsmov bx, offset ResStrmov cl, byte ptr [bx] inc bx @@ 1: mov al, [bx]; get a charactercmp al, 'a'jb @@ 2; <' a ', then @@ 2;>' Z ', the Jumpand Al, 5FH; Converted to Uppercasemov [BX ], Al; Store to string @@ 2: incn; point to next characterLoop @@ 1 @@ 4: pop ds; restore dspop bp; restore bpretf 4; Remove Parameter and Return Function Lowerstrpublic Lowerstr RESSTR EQU DWORD PTR [BP 10] S EQU DWORD PTR [BP 6] Lowerstr: Push BP; Save BPMOV BP, SP; Save Up Stack Framepush DS; Save Dsxor Ch, Chmov BX, Offset Smov Cl, Byte Ptr [BX] JCXZ @@ 4inc CLLDS Si, S; Load String Addressles Di, RESSTR; LOAD result addresscld; Forward string-ups @@ 3: lodsb; Load a characterstosb; Copy a characterloop @@ 3; Loop for all characterspush espop dsmov bx, offset ResStrmov cl, byte ptr [bx] inc bx @@ 1: mov al, [bx]; get a charactercmp al, 'a'jb @@ 2; <' a ', then @@ 2;>' Z ', THEN JUMPOR AL, 20H; Converted to LowerCasemov [BX ], Al; Store to string @@ 2: incn; point to next characterLoop @@ 1 @@ 4: pop ds; restore dspop bp; restore bpretf 4; Remove Parameter and Return End Program 3: astrdemo.pas {---------------------------------} {astrdemo.pas} {Demonstrates The usage of ask} {Written by dong zhanshan} {version: june 1994} {---------------------------------------------------------------------------------------------------------------------- ---} Program astrdemo; Uses astr; VARS1, S2: STRING; N1: Integer; Procedure updemo; vari: integer; begins1: = '; for i: = 1 to 26 do s1: = s1 chr (96 i); S2: = UpPerstr (S1); Writeln (' Upper: ', S2) Writeln ('Lower:', Lowerstr (S2)); END; Procedure HexStrdemo; VARI, J: Integer; BeginWriteln ('Print ASCII Code, DEX |); i: = 0; Repeatfor J: = 1 To 5 DobeGininc (i); Write (INTSTR (I, 3),' | ', HEXSTR (I, 1),' | ', CHR (I), Space (2)); if i = 255 damEginwriteln; End; End; End; Writeln; Until i = 255; Procedure DateTimedemo; BeginWriteln ('Today Is', Datestr, Space (2), TIMESTR); END; VAR CH: Char; Num: longint; s: string; beginuplowdemo; hexStrDemo; DateTimedemo; End. -------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------- ----------------- You are a wind, I am a sand, the forum is my home. PS: "Sands" is my old ID, "water-wood sand": = "Snow people" newly registered a ID - Passbyword, or me. 2003-4-2 15:56:56 Sands Title: Webmaster Level: Administrator Prestige: 2 Articles: 927 Points: 1863 School: Anti-Japanese Union Registration: 2002-8-4 §2.3 Disk Input Output Unit Disk Disk input and output unit Disk is a collection of processes and functions related to disk, including read and write disk physical sector processes, read and write hard disk main boot recording, read and write disk start sector, test disk status functions, take current The physical disk number function of the disk is detected whether the disk is ready. In addition, three data structures related to disk structure are also defined. §2.3.1 DISK unit definition data structure The Disk unit defines the three types of data structures, namely the main boot record type, the partition table type, the Boot record type, which specifically introduces the field and its meaning of the record type. 1. Partition Type PartitionType Partition Type PartitionType See Program 1, using it directly to read and modify partition information of the hard disk. The meaning and value of each field of PartitionTyped is as follows: bootindicator is the start flag, can take 0 or 128, 1 bytes; 128 represents the active partition, otherwise it is a non-active partition; Starthead is the beginning of the partition, 1 byte; startseector The number of sectors started, 1 byte; startcylinder is the number of columns started by the partition, 1 byte; sysindicator is the system flag, can be 0 (no definition), 1 (DOS-12), 4 (DOS-16), 5 (extended, 6 (bigdos) equivalence, 1 byte; endhead is the number of headers, 1 byte; endsector is the number of partitions, 1 byte; endcylinder is the number of partitions, 1 byte RelativeSector is the number of relative sectors, double words; Totalsector is the total number of sectors, double words. 2. The main guidance record type MbrtMBRT is defined. The meaning and values of each field are as follows: Mainboot is the main bootstrap and error information, accounting for 446 bytes, and the content can be found to find the computer to infect the main guided virus. PartitionTable is a hard disk partition information table, which is a one-dimensional array of partition record types, accounting for 64 bytes; token is a valid flag for system startup, and 55AAH. 3. The definition of Boot record type BRTBRT is shown. The meaning and values of each field are as follows: Pro1 is the transfer instruction, 3 bytes; ID is the vendor flag field, 8 bytes; SS is the sector length, Generally 512, 1 word; AU is the distribution unit, and the number of sectors per cluster, 1 byte; RS is the number of sectors, 1 word; NF is the number of FAT, generally 2, 1 word Festival; DS is the root directory contains file number, 1 word; TS is the number of total sectors, 1 word; MD is the disk media descriptor, 1 byte; FS is the number of sector of each FAT, 1 Word; ST is the number of sectors contained in each direction; NH is the number of magnetic heads, 1 word; HS is implied by the number of sectors, generally used for hard disk partition, 1 word; XX is unused, 1 Word; BS is a large DOS partition sector, double word; PD is a physical disk number, 1 word; ES is the extended start recording flag, 1 byte; VS is a volume series, double word; VL is a volume label, 11 Bytes; Fi is the system flag string, corresponds to the system flag of the partition table type, 8 bytes; PROG starts the code area, 452 bytes. §2.3.2 DISK function and process Process Function 1.ProcessPhysicalSector physical sector read and write disk usage ProcessPhysicalSector (OperateType: byte; DriveType: byte; HeadNo: byte; StartCyl: byte; StartSec: byte; SectorNumber: byte; var p) Description OperateType disk operation, 2 Read the disk, 3 is the write disk, the byte type driveType is the disk number, the A disk is 0, the B disk is 1, the C disk is 128, the byte type Headno is the beginning of the header, the byte type startcyl is the number of starting column, The byte type startsec is the number of start sectors, the byte type sectornumber is to be read, the number of write sectors, the byte type P is the disk operation buffer, and there is no type. 2. ReadmainbootRec process function ReadmainBootRec (startcyl, startsec: byte; var p: mbrt) Description STARTCYL is the number of starting column, the byte type startsec is the number of start sectors, the byte type P is the disk buffer Change parameters of type MBRT 3.WriteMainBootRec process function write hard disk main boot record usage WriteMainBootRec (startcyl, startsec: byte; var p: mbrt) Description STARTCYL is starting the number of cylinders, the byte type startsec is the number of start sectors, the byte type P is the disk buffer Change parameters of type MBRT 4. Readbootsector Process Function Read Boot Sector Usage Readbootsector (Drive, Starthead, Startcyl, Startsec: Byte; VAR P: BRT) Description Drive is a disk number, a disk is 0, the B disk is 1, the C disk is 128, bytes STARTHEAD is the beginning of the number, the byte type startcyl is the number of starting column, the byte type startsec is the number of start sectors, the byte type P is the disk operation buffer, and the type of BRT is changed. 5.WriteBootSector Process Function Write Block Usage Writebootsector (Drive, Starthead, Startcyl, Startsec: Byte; VAR P: BRT); Description Parameter meaning with readbootsector6.getMediabyte function function Take the current disk media descriptor Differentiabyte results Type byte Return the value disk media descriptor, with the following value: FFH is 320K 5.25 "floppy disk FEH is 160K 5.25" floppy disk FDH is 360K 5.25 "floppy disk FCH is 180K 5.25" floppy disk F9H is 1.2M 5.25 "floppy disk or 720K 3.5" floppy disk F8h is Hard disk F0H is 1.44m 3.5 "floppy disk 7.Getdriveno function function to take the physical disk number GetDriveno result Type byte type return value Current physical disk number, 0 is a disk, 1 is a B disk, 128 is a C disk 8. DRIVASE Function Function Test Soft Disk Status DriveCase (Driveno: Byte) Result Type byte Type Driveno is a physical disk number. Return value soft disk status, 0 is normal, 2 is not closed disk machine, 12 is not formatted for disk, 255 is an illegal driver 9.Autoknow process function automatic sensing disk preparation or no method AutokNow (drive, mode: byte) Description DRIVE is driven, 0 finger A drive, 1 refers to the B drive; MODE means A or B drive and disk type, 03 represents 1.2MB floppy disk in the 1.2MB drive §2.3.3 Disk DiskDemo demonstrates the usage of the DISK unit part of the process. §2.3.4 Source Procedure List Program 1: Disk.pas {*******************************************} {unit: disk} {Disk In / out unit} {Written by dong zhanshan} {version: july 1994} {***************************************** ***} Unit disk; {$ D-, S-} Interface typePartitionType = recordBootIndicator: Byte; StartHead: Byte; StartSector: Byte; StartCylinder: Byte; SysIndicator: Byte; EndHead: Byte; EndSector: Byte; EndCylinder: Byte; RelativeSector: longint; TotalSector: longint; end; Mbrt = Recordmainboot: array [0..445] of byte; partitionTable: array [1..4] of partitionType; token: array [1..2] of byte; end; ByTE; ID: ARRAY [1..8] of char; s: word; {bytes per sector} au: byte; {sectors per cluster} RS: word; {reserved Sectors at beginning; {root; {root directory entries} ts: word; {total sectors on disk} md: byte; {media descriptor byte} fs: word; {sectors per fat} ST : word; {sides} nh: word; {sides} HS: word; {hiden sectors} {extended Parts of boot record} xx: word; {unused; {brig total number of research bar} : Word; {Physical Drive Number} es: Byte; {Extended Boot Record Signature} vs: longint; {volume serial number} VL: array [1..11] of char; {volume label} fi: array [1 .. 8] of char; {file system ID} prog: array [1..452] of byte; end; Procedure ProcessPhysicalSector (OperateType: byte; DriveType: byte; HeadNo: byte; StartCyl: byte; StartSec: byte; SectorNumber: byte VAR P); Procedure ReadmainBootRec (Startcyl, Startsec: Byte; Var P: Mbrt); Procedure WritemainBootRec (Startcyl, S tartSec: byte; var p: MBRT); procedure ReadBootSector (Drive, StartHead, StartCyl, StartSec: byte; var p: BRT); procedure WriteBootSector (Drive, StartHead, StartCyl, StartSec: byte; var p: BRT); function GetMediaByte : Byte; Function Drivecase (driveno: Byte): Byte IMPLEMENTATION {$ L disk.obj} PROCEDURE processPhysicalsector; external {disk}; {$ F } Procedure ReadmainBootrec; BeginProcessphysicalsector (2, $ 80, 1, Startcyl, StartSec, 1, P); END; Procedure WritemainbootRec; BeginProcessphysicalsector (3, $ 80, 1, Startcyl, Startsec, 1, P); END; Procedure Readbootsector; BeginProcessphysicalsector (2, Drive, Starthead, Startcyl, Startsec, 1, P); END; Procedure Writebootsector; BeginProcessphysicalsector (3, Drive, Starthead, Startcyl, Startsec, 1, P); End; $ f-} function getMediabyTe; external {disk}; Function getDriveno; external {disk}; Function drivecase; external {disk}; End. Program 2: Disk.asm; Disk.asm; Assembler Including File for Disk.Pas Unit Title Disklocals @@ dosseg.model tpascal.codeassume cs: @code Function Drivecase Public DriveCase Drivecase: Push BPMOV BP, SPPUSH DSMOV AL, BYTE PTR [BP 6] MOV AH, 0MOV CX, 1MOV DX, 0MOV BX, Offset CS: BUFPUSH CSPOP DSINT 25HJC @@ 1mov Al, 0 @@ 1: Add SP, 2POP DSPOP BPRETF 2BUF DB 512 DUP (0) Function getMediabyTe; Public getMediabyte GetMediabyte: Push DSMOV AH, 1BHINT 21HMOV AX, DS: BXPOP DSRETF Function GetDriveno; Public GetDriveno GetDriveno: Mov Ah, 19HINT 21hRetf ; Procedure Processphysicalsector; Public Processphysicalsector ProcessPhysicalsector: Push BPMOV BP, SPPUSH ESMOV AX, [BP 08] MOV ES, AXMOV BX, [BP 06] MOV Ch, Byte Ptr [BP 0EH] MOV CL, BYTE PTR [BP 0CH] MOV DH, BYTE PTR [BP 10H] MOV DL, BYTE PTR [BP 12H] MOV AH, BYTE PTR [BP 14H] MOV Al, Byte Ptr [BP 0AH] INT 13HPOP ESPOP BPRETF 12H End Program 3: DiskDemo.pas {---------------------------------} {DISKDEMO.PAS} {DemonStrates {Written by disk} {written by Dong zhanshan} {version: july 1994} {---------------------------------------------------------------------------------------------------------------------------- ---} Program diskdemo; Uses acrt, disk; ConstMBRF = 'mrecord.sav'; brf = 'boot.sav'; varF1: file; Procedure ReadbootDemo; VAR B: BRT; BeginProcessphysicalsector (2, $ 80, 1, 0, 1, 1, Mr); Assign (F1, BRF); REWRITE (F1, 1); Blockwrite (F1, B, 512); Close F1); Procedure ReadmainRecorddemo; Var Mr: Mbrt; BeginProcessphysicalsector (2, $ 80, 0, 0, 1, 1, Mr); Assign (F1, MBRF); REWRITE (F1, 1); Blockwrite (F1, MR, 512); Close F1); End; Beginif YESNO ('Read The Main Boot Record in Hard Disk ") ThereadmainRecordDemo; if Yesno (' Read The Boot Record in Hard Disk") ThenReadbootDemo; end. §2.4 Hotkey Unit Popup The three processes defined in the POPUP unit, one for defining the hot key process, the remaining two are used to allow or disable the use of hot keys in the program. The basic principle of this unit is to capture hot keys with a keyboard interrupt, start the hot key process with a clock interrupt, and another hot key process cannot be started during a hotkey process activity. With this unit, 100 hotkey processes can be defined in the program. §2.4.1 Functions and processes of POPUP 1.popupproc process function Defines the hot key process usage PopuProc (Pr: Pointer; SC, KM: BYTE) Description PR Description PR is the entrance address of the hotkey process, the pointer type SC is the value of the hotkey's scan code KM as the value of the keyboard status byte, The following values can be obtained: 1 To press the right shift key 2 to press the left SHIFT button 4 to press the CTRL button 8 to press the ALT key 16 for the ScrollLock button. 32 is the NUMLOCK button valid 64 for the CapSlock button 128 is effective for the INS button 2.EnablePoP Process Function Allows Using Hotkeys EnablePoP 3. DisablePoP Process Function Prohibits Using Hotkeys Disablepop §2.4.2 use of POPUP PopDemo.Pas demonstrates how the POPUP unit is used. §2.4.3 List of Source Procedures Program 1: popup.pas {***************************************************** **} {unit: popup} {popupa (hotkey) procedure interface unit} {Written by dong zhanshan} {version: june 1994} {********************** ********************************* Unit Popup; {$ D-, S-} Interface Uses dos; Procedure PopuppProc (Pr: Pointer; SC, KM: Byte); Procedure EnablePoP; Procedure Disablepop; IMPLEMENTATION constTimerInt = $ 1C; KbdInt = $ 9; CritInt = $ 24; PopFlag: Boolean = False; {True when press HOTKEY} Running: Boolean = False; {True when program is actival} ScanCode: Byte = 0; {Scan Code for HOTKEY} Keymask: byte = 0; {Keyboard State Byte} Maxhotkey: Byte = 0; {Maximum NumBers of Hotkey} TypehotKeyRec = RecordProc: Pointer; Scancode: Byte; Keymask: Byte; End; varTimerVec, KbdVec, OldCritVec: Pointer; {Save old vector} PopRtn: Pointer; {Popup procedure pointer} SaveBreak, TsrByte, DOSSEG, {Start segment of DOS system} INDOS: Word; {Busy mark of the DOS} HotKey: Array [ 1..100] OF HotKeyRec; Scancode: set of byte; procedure cli; inline ($ fa); procedure sti; inline ($ fb); Procedure Newcrit (Flags, CS, IP, AX, BX, CX, DX, Si, Di, DS, ES, BP: WORD); Interrupt; Begin Ax: = 0; Procedure Calloldint (Sub: Pointer); {Call the old int} Begininline ($ 9C / {Pushf} $ FF / $ 5e / $ 04); {Call DWORD PTR [BP 4]} END; Procedure CallPopproc (Sub: Pointer); Beginrunning: = true; inline ($ FF / $ 5e / $ 04); {Call DWORD PTR [BP 4]} Running: = FALSE; END; Procedure Clock (Flags, CS, IP, AX, BX, CX, DX, Si, Di, DS, ES, BP: WORD); Interrupt; Begincalloldint (Timervec); if (Popflag) and (Mem [Dosseg: Indos] = 0) THENBEGINCLI; Port [$ 20]: = $ 20; STI; POPFLAG: = FALSE; CallPopProc (poprtn); end; Procedure Keyboard (Flags, CS, IP, AX, BX, CX, DX, Si, Di, DS, ES, BP: WORD); Interrupt; Varsc: Byte; Procedure CheckKey; Var i: Word; Beginif (Port [$ 60] in Scancodset) THENBEGINSC: = Port [$ 60]; for i: = 1 to maxhotkey doif sc = 1 to maxhotkey doif sc = hotkey [i] .scancode dameginscancode: = Hotkey [i] .scancode Keymask: = Hotkey [i] .Keymask; poprtn: = hotkey [i] .proc; end; end; BegincheckKey; IF ((($ 0040: $ 0017) and keymask = keymask) ThenbegintsRbyte: = port [$ 61]; port [$ 61]: = Tsrbyte OR $ 80; port [$ 61] : = TsrByte; CLI; Port [$ 20]: = $ 20; STI; if not running the popflag: = true; endelsecallold (kbdVec); procedure EnablePop; begininline ($ b4 / $ 34 / $ cd / $ 21 / $ 8c / $ 06 / DOSSeg / $ 89 / $ 1e / INDOS); {save INDOS address} GetIntVec (TimerInt, TimerVec); GetIntVec (KbdInt, KbdVec); GetIntVec (CritInt, OldCritVec); SetIntVec (CritInt, @ NewCrit); SetIntVec (TimerInt, @ Clock); SetIntVec (KbdInt, @ KeyBoard); SetIntVec ($ 1B, SaveInt1B); end; Procedure PopUpProc (PR: Pointer; SC, KM : Byte); Begininc (maxhotkey); with hotkey [maxhotkey] dobeginscancode: = sc; keymask: = km; proc: = pr; end; scancode: = scancodeet [sc]; Procedure Disablepop; Varp: Pointer; BeginsetInTVec (Timerint, Timervec); SetInTVec (Kbdint, KbdVec); SetInTVec (critint, OldcritVec); Beginfillchar (HotKey, Sizeof (Hotkey), # 0); ScancodeEt: = []; END. Program 2: PopDemo.pas {----------------------------------} {popdemo.pas} {DemonStrates The usage of popup} {Written by dong zhanshan} {version: june 1994} {---------------------------------------------------------------------------------------------------------------------- ---} {$ F } {procedures must be caled by far call} PROGRAM POPUPDEMO; Uses DOS, CRT, POPUP; VAR CH: char; procedure PopUpProc1; beginclrscr; textattr: = 2 * 16 15; repeatwriteln ( 'Popup procedure 1'); writeln ( 'Please enter a key'); writeln ( 'Enter ESC to quit this procedure'); ch: = readkey; Writeln ('Your Entered Key IS', CH); Until CH = # 27; TexttTr: = 15; procedure PopUpProc2; beginclrscr; textattr: = 1 * 16 14; repeatwriteln ( 'Popup procedure 2'); writeln ( 'Please enter a key'); writeln ( 'Enter ESC to quit this procedure'); ch: = readkey; Writeln ('Your Entered Key IS', CH); Until CH = # 27; TexttTr: = 15; beginPopUpProc (@ PopupProc1, $ 3b, $ 08); PopUpProc (@ PopupProc2, $ 3c, $ 08); EnablePop; repeatwriteln ( 'Please enter a key, Enter ESC to quit'); ch: = readkey; writeln ( 'Your entered key IS: ', CH); Until CH = # 27; disablepop; end.§2.5 Database interaction unit DBASE This unit is written in order to make Turbo Pascal program interact with database software DBASE III, FOXBASE. The unit contains three general processes, a library structure information for opening and reading database files, one for closing database files, another record for reading DBase database files. The unit also defines several data types. §2.5.1 Data type and constant of dBase unit 1. Field Type FieldTypefldName is the field name, 10-byte string FldType is the field type, the characteristic fldoffset is the location in the record, the word FldWidth is the field width, and the byte Posdec is a decimal point position of the digital field. Byte 2. Field Type array and its pointer each record up to 128 fields, so FieldTypeArray is a 1-dimensional array of 128 fieldType type elements; FieldTypePtr is a pointer type of FieldTypeArit type; 3. Database Structure information Type StructypenumRec is recorded Number, long-integer startposdata is the beginning of the record data, the length of the word length, the length of each record, the character number Numfield is the number of fields, the byte type field is the database field pointer, the fieldTypePtr type 4. record type The array and its pointer have up to 4000 characters per record, so RectypeArray is a one-dimensional array of 4000 char type elements; RectyPeptr is the pointer type corresponding to RectyPearRay; §2.5.2 Process and functions of DBASE unit 1. OpendBase process function opens the DBase database of the specified name, and read its structure information usage OpenDBase (dbfname: string; var dbf: file; var recuctype) Description DBFNAME is a string type, represents the database file name, must include expansion Name DBF is a non-type file variable RECINFO for database structure information variable, Structype type 2. ReadRecord Process Function Read Database Record Usage ReadRecord (VAR DBF: File; Recno: Longint; Recinfo: Structy; Var Rec: Rectypeptr) Description DBF is a record number, long-term type Recinfo is database structure information, Structype type REC is a recording variable, RectyPeptr type 3.ClosedBase process function Close the database file usage closedBase (var dbf: file; recnfo: structy), the DBF is a database structure information, Structype type §2.5.3 Use of DBase database unit First, use OpenDBase to open the database file and read the structure of the database, and then read any records for the database with ReadRecord. After the database is used, close the database file with CloseDBase. About the use of DBASE units is demonstrated by dbdemo.pas, and can also refer to §3.9 database card card PDBC.PAS §2.5.4 List of Source Procedures Program 1: dbase.pas {dbase.pas 1.0} {CopyRight (c) 1994 dong zhanshan} Unit dbase; Interface TypefieldType = Record FldType: String [10]; FLDTYPE: CHAR; FLDOFFSET: WORD; FLDWIDTH: BYTE; Posdec: Byte; End; {EndTypeArray = Array [1..128] of FieldType; FieldTypePtr = ^ FieldTypeArray; StrucType = recordNumRec: longint; StartPosData: word; LengthRec: word; NumField: byte; Field: FieldTypePtr; end; {Each record up to 4000 characters} RecTypeArray = Array [1..4000] of char; RecTypePtr = ^ RecTypeArray ; procedure OpenDBase (DbfName: string; var dbf: file; var RecInfo: StrucType); procedure ReadRecord (var dbf: file; RecNo: longint; RecInfo: StrucType; var Rec: RecTypePtr); procedure CloseDBase (var dbf: file; RecInfo: Structype); IMPLEMENTATION Procedure ClosedBase; BeginClose (DBF); with Recinfo Do Freemem (Field, Numfield * 32); END; Procedure OpenDBase; Var i, J, L: Integer; AB: Array [1..32] of byte; beginassign (DBF, DBFNAME); Reset (DBF, 1); BlockRead (DBF, AB, 12); with Recinfo DobeginnumRec : = ab [5] ab [6] * 256 ab [7] * 256 * 256 ab [8] * 256 * 256; startposdata: = ab [9] ab [10] * 256; lengthrec: = AB [11] AB [12] * 256; Numfield: = (StartPosData - 33) DIV 32; GetMem (Field, Numfield * Sizeof (FieldType)); Seek (DBF, 32); for i: = 1 To Numfield DobeginBlockRead (DBF, AB, 32); L: = 0; for J: = 1 to 10 do if ab [j] <> 0 THEN INC (L); with Field ^ [i] dobeginmove (ab [1], fldname [ 1], L); FLDNAME [0]: = Char (L); FLDTYPE: = CHR (ab [12]); FldWidth: = ab [17]; posdec: = ab [18]; if i = 1 Then Fldoffset : = 0ELSEBEGINFLDOFFSET: = Field ^ [1] .fldwidth; for j: = 2 to i - 1 Dofldoffset: = fldoffset Field ^ [j] .fldwidth; end; end; end; end; end; procedure ReadRecord; var ch: char; beginwith RecInfo dobeginseek (dbf, StartPosData LengthRec * (RecNo-1)); blockread (dbf, ch, 1); blockread (dbf, Rec ^, LengthRec); end; end; end. Program 2: dbdemo.pas {-----------------------------------} {dbdemo.pas} {written by dong zhanshan} {version : Oct. 1994} {-----------------------------------} PROGRAM DBDEMO; Uses dbase; VARRECINFO: STRUCTYPE; RECTYPTR; F1: FILE; procedure DisplayStruc (RecInfo: StrucType); var i: word; beginwith RecInfo dobeginWriteln ( 'Number of Records:', NumRec); Writeln ( 'Length of a Record:', LengthRec); Writeln ( 'Number of Field:', NumField ); Writeln ('name type width dec "; for i: = 1 to Numfield Dowith Field ^ [i] Dowriteln (FldName: 10, FLDTYPE: 4, FLDWIDTH: 8, Posdec: 7); end; BeginopendBase ('TRA.DBF', F1, Recinfo); DisplayStruc (Recinfo); ClosedBase (F1, Recinfo); END. ---------------------------------------------- you are a wind I am sand, the forum is my home PS: "Sands" is my old ID, "water-wood sand": = "Snow people" newly registered a ID - Passbyword, or me. 2003-4-2 15:58:15 Sands Title: Webmaster Level: Administrator Prestige: 2 Articles: 927 Points: 1863 School: Anti-Japanese Union Registration: 2002-8-4 §2.6 Extended Memory Usage EMS The extended memory usage unit is a collection of processes and functions related to the detection, allocation, use, and release of extended memory, and a collection of data types. It includes 1 new data type, 8 functions, and 1 process. §2.6.1 Data types of extended memory cells The unit defines a type EMBSTRUC associated with data between extended memory and conventional memory. Its field and its meanings are as follows: count is the number of bytes of data to be transferred, long integer SRCTYPE source type, byte type; 0 Represents conventional memory, 1 represents the extended memory srchandle source handle; 0 represents conventional memory, non-zero representation extended memory srcoffset source address offset; Dictionar SrcSegment source segment address; Dictionary Destype destination type, byte type; 0 representative Conventional memory, 1 represents the handle of the extended memory deshandle destination; 字;; 0 represents conventional memory, non-zero representation extended memory DESOFFSET destination address offset; Dictionary Dessegment destination section; §2.6.2 Extending the process and functions of memory cells 1.EMMTEST function function detection whether there is an EMM driver usage EMMTEST result type Boolean return value EMM exists Return true, there is no return false2.emSstat function function When the EMM is present, the state of the EMM is detected EMSSTAT results type Boolean return value EMM No error, return true, otherwise returning false 3.emver function function EMM version number EMSVER results Type byte type return value Return to a version of the version number, high 4 bits are the main version of the BCD code, low 4 digits are the second version of the BCD code 4. EMBFree Function Function Release The Assigned Extended Memory Block Method Embfree (Handle: Word) Result Type Boolean Signaling Handle is the extended memory handle, the word return value is successfully released, return true, otherwise return False 5. EMBalloc function function Assign extended memory block Usage Emballoc (nbytes: longint) Result Type Dictionary NBYTES To assign the byte number of bytes to allocate the extended memory block, return to the extended memory handle, otherwise returning 0 6.EMSPAGE Process Function Get EMS Page Note Emspage (Var Totalpage, LeftPage: Word) 7.emFrame function function Gets the page frame address of EMS EMSFRAME results Type Dictionaries return value EMS page segment address 8.EMBGET function function From the extended internal access data usage Embget (VAR ARR; NBYTES: Longint; Handle: Word) Result Type Boolean Description Arr is a non-type variable, is used as a data buffer; nbytes is constant, transmitted data Length; Handle is a font, returning to TRUE for extended memory handles, and returns false, otherwise returns false 9. EMBPUT function function Transfer data usage EMBPUT (VAR ARR; NBYTES: Longint; Handle: Word) result type Boolean Description Arr is a non-type variable for data buffer; nbytes is constant, transmitted data Length; Handle is a font, transferring data successfully returned to TRUE for extended memory handles, otherwise returning false §2.6.3 Extending memory cells EMSDemo.Pas demonstrates the use of the EMS unit. The program first uses EMMTEST to detect whether the EMM program exists, exists, calling EMSPAGE and EMSVER to display the number of EMS memory, the version number of the EMM, and allocate the extended memory that can accommodate more than 10000 solids, transfer 10000 real numbers in array Arr to extended memory , Set the ArR number to zero, retrieve the 10000 factor from the extended memory into the ARR, display 100,000 data in the Arr, finally, release the application's extended memory. §2.6.4 Source Procedure List Program 1: Ems.PAS {********************************************} {unit: EMS} { Written by dong zhanshan} {version: sept.1994} {***************************************************** Unit EMS; Interface TYPEEMBSTRUC = RecordCount: Byte; srchandle: word; srcoffset: Word; srcsegment: Word; DESTYPE: BYTE; DESHANDLE: WORD; DESOFFSET: WORD; DESSEGMENT: WORD; function EMMtest: boolean; function EMSstat: boolean; function EMSVer: byte; function EMBFree (Handle: word): boolean; function EMBAlloc (nbytes: longint): word; procedure EMSPage (Var TotalPage, LeftPage: word); function EMSFrame: word Function Embget (VAR Arr; Nbytes: longint; handle: word): boolean; function Embput (var arr; nbytes: longint; handle: word): boolean; importation {$ L Ems.obj} Function EMMTAT; EXTERNAL; FUNCTION EMSVER; EXTERNAL; proctern ;; external; function emsframe; Function Alloc (N: Word): Word; External; Function Embmov (Var Emb: Embstruc): Boolean; External; Procedure DisplayemSerror (ErrorNo: Byte); Const Errorstr: Array [1..14] of string [79] = ('Size is invalid'), ('Emm Driving Routine Is Not Installed ", (' EMM Software Failure '), (' EMS Hardware Failure '), ('), ('Invalid Handle'), ('Invalid Function of emm '), (' NO Available Handle '), ('), ('Applied Pages Are More Than EXISTING PAGES'), ('Applied Pages Are More Available Pages'), (' '), (') NO. OF PAGE '), (' INVALID Physical Page '); Beginif ErrorNo <> 0 Then Writeln (' error: ', Errorstr [ErrorNo - $ 7D]); Function Emballoc; var N: Word; Beginn: = (Nbytes $ 3FFF) Div $ 4000; EMBALLOC: = Alloc (n); end; Function Embput (var arr; nbytes: boolean; var Emb: embstruc; beginwith Emb: = 0; srcSEGMENT: = OFS (arr); srcSegment: = OFS (arr); srcsegment: = OFS; SRCSEGMENT: = SEG (Arr); DESTYPE: = 1; deshandle: = Handle; Desofset: = 0; Dessegment: = 0; if Embmov (EMB) THEN Embput: = true else Embput: = false; end; end; function Embget (Var Arr NBYTES: WORDINT; HANDE: WORD): Boolean; Var Emb: Embstruc; beginwith Emb: = nbytes; srctype: = 1; srchandle: = handle; srcoffset: = 0; srcsegment: = 0; Destype: = 0; deshandle : = 0; Desofset: = OFS (Arr); Dessegment: = SEG (Arr); if Embmov (EMB) THEN Embget: = True else Embget: = false; End. Program 2: EMS.ASM Title Emsdosseglocals @@. Model tpascal.codessume cs: @code EXTRN DISPLAYEMSERROR: NEAR DEVNAME DB 'Emmxxxx0' Function Emmtest Public emmtest Emmtest: Push BPMOV BP, SPPUSH ESMOV AX, 3567HINT 21HMOV DI, 10PUSH DSMOV AX, CSMOV DS, AXMOV SI, OFFSET DEVNAMEMOV CX, 8REP CMPSBPOP DSMOV AL, 0JNE @@ 1MOV Al, 1 @@ 1: Pop Espop BPRETF Function EMSSTAT Public EMSSTAT EMSSTAT: PUSH BPMOV BP, SPMOV AH, 40HINT 67HMOV AL, AHPUSH AXCALL DISPLAYEMSEEMSERRORMOV AL, 0CMP AH, 0JNE @@ 1MOV Al, 1 @@ 1: Pop BPRETF Procedure EMSPAGE Public EMSPAGE EMSPAGE: PUSH BPMOV BP, SPPUSH DSMOV AH, 42HINT 67 HLDS SI, [BP 6]; Number of Left PageSMOV [Si], BX; LDS Si, [BP 10]; Number of Total PageSMOV [Si], DX; MOV Al, AHPUSH AXCALL DisplayemSerrorPop DSPOP BPRETF 8 Function EMSFrame: Word; Public EMSFRAME EMSFrame: Push BPMOV BP, Spmov AH, 41HINT 67HMOV AL, AHPUSH AXCALL DISPLAYMSERRORMOV AX, BXPOP BPRETF Function EMSVER Public EMSVER EMSVER: PUSH BPMOV BP, Spmov AH, 46HINT 67HPUSH AXMOV AL, AHPUSH AXCALL DisplayemSerrorPop Axpop BPRETF; FUNTION Alloc Public Alloc Alloc: Push BPMOV BP, Spmov AH, 43HMOV BX, [BP 6] INT 67HPUSH AXMOV AL, AHPUSH AXCALL DISPLAYMSERRORPOP AXMOV AX, DXPOP BPRET 2 Function Embfree Public Embfree Embfree: Push BPMOV BP, SPMOV DX, [BP 6] MOV AH, 45HINT 67HMOV AL, AHPUSH AXCALL DisplayemSerrorMov Al, 0CMP AH, 0JNE @@ 1mov Al, 1 @@ 1: Pop BPRETF 2 FUNCTION Embmov Public Embmov Embmov: Push BPMOV BP, SPPUSH DSPUSH SILDS SI, [BP 4] MOV AX, 5700HINT 67HMOV AL, AHPUSH AXCALL DISPLAYEMSERRORMOV AL, 0CMP AH, 0JNE @@ 1MOV Al, 1 @@ 1: Pop Sipop DSPOP BPRET 4 end Program 3: EMSDEMO.PAS {-----------------------------------} {EMSDEMO.PAS} {DemonStrates the usage of ems} { Written by dong zhenshan} {version: sept.1994} {---------------------------------} PROGRAM EMSDEMO; Uses EMS; CONSTSIZE = 10000; VAR Ver, Primever, SecondVer: Byte; Ar: Array [1..size] of real; handle: Word; i, j: word; Beginif Emmtest thenbeginemspage (I, J); Writeln ('EMS Total Pages: =', I, 'Left Pages: =', J); Ver: = Emsver; Primever: = (Ver and 240) SHR 4; secondVer: = Ver and 15; Writeln ('EMS Version:', Primever, '.', SecondVer; Handle: = Emballoc (SizeOf (ar)); Writeln (Handle); for i: = 1 To size do ar [i]: = ln (i); if Embput (Ar, Sizeof (ar), handle) THEN WRITELN ('Put EMS OK'); for i: = 1 to size do ar [i]: = 0; if Embget (Ar, Sizeof (AR), HANDLE) THEN WRITELN ('Get EMS OK'); for i: = 1 to size do Write (i: 7, ':', ar [i]: 8: 4); if Embfree (Handle) Writeln ('Free EMS OK!'); endelsewriteln ('EMS DOES NOT'); END. §2.7 Expansion Memory Using Unit XMS The expansion memory usage unit contains the functions of the first chapter of the expanded memory management specification, and the expansion memory can be used in the Turbo Pascal program. The unit defines 15 functions and 1 process while defining three record types, 1 variable, and 4 regions. §2.7.1 Data structure defined by XMS unit The following describes the three recorded data types defined by the XMS unit, four constants related to the status of the A20 address line and a variable ErrorsTatus that stores XMS call incorrect states. 1.XMS status record type XMS_STATUSVERSION is the version number, the word revision is the internal version number, the word hma_exist is the flag existing in the high internal storage area, Boolean 2.XMS Memory Status Record Type XMS_MEM_STATLARGESTBLOCK to maximize memory distribution blocks, with a KB meter, font totalfreeMemory is the total freely expanded memory block, with a Kb meter, font 3. Memory block Transfer Parameter Structure Type Embstruccount is the number of bytes, long integer SourceHandle is the source handle, font, 0 represents conventional memory, non-0 represents the expansion memory SourceOfs for source offset, long integer destinhandle as a destination handle , Font, 0 represents conventional memory, non-0 represents the expansion memory Destinofs offset, long integer 4. 4 constant GlobalEnablea20 related to the A20 address line The full open A20 address line function GlobalDisablea20 is the full shutdown A20 address line function localenablea20 to local open A20 address line function LocalDisablea20 is local to close A20 address line function §2.7.2 Process and functions of XMS unit 1.XMS_TEST function function detects whether the XMM exists XMS_TEST results type Boolean return value If the XMM is returned to True, otherwise returns false 2.xms_stat process function detects XMM status XMS_STAT (VAR Stat: XMS_STATUS) to say that Stat is a change in XMS_STATUS 3.XMS_AVAIL Function Function Take XMS Memory Status XMS_AVAIL (VAR MemStat: XMS_MEM_STAT) Result Type Boolean Ming MemStat is a variable para-reference value for xms_mem_stat type If XMS is unleired to return true, otherwise return false 4.XMS_alloc function function Assign XMS memory usage xms_alloc (ksize: word; var handle: word) Result Type Boolean Description Ksize is the size of XMS memory, with a KB meter, font type handle is an XMS memory handle, a word type variable returns Value allocation successfully returns true, allocation failure Returns False 5.XMS_REALLOC Function Function Reassign XMS Memory Usage XMS_REALLOC (Ksize, Handle: Word) Result Type Boolean Description Ksize is the size of XMS memory to reassign, with a KB meter, the word value parameter handle is an XMS memory handle, a word type Value parameter return value If the redistribution success returns true, otherwise return false 6.XMS_FREE Function Release The specified XMS Memory XMS_Free (Handle: Word) result type Boolean language is the XMS memory handle, the word value parameter return value If the XMS memory release returns true, otherwise returns false 7.XMS_LOCK Function Functional Lock Assigned XMS Memory Usage XMS_Lock (Handle: Word; Var myaddr: Longint) Result Type Boolean Description Handle is a handle that has been assigned XMS memory, the word value ginseng myaddr is the lock memory address, long Integer change ginseng return value If the lock is successfully returned to true, return FALSE 8.XMS_UNLOCK Function Function Unlock Locked XMS Memory Usage XMS_UNLOCK (Handle: Word) Result Type Boolean Description Handle is a handle of the lock XMS memory, the word value gauge return value If the unlock is successfully returned to true, otherwise return false9.xms_bstat functions Function Exchangement Memory Control Block Handle Information Usage XMS_BSTAT (Handle: Word; Var Lockcount, NumfreeHandle: Byte) Result Type Boolean Description Handle is an XMS memory handle, the word value ginseng LockCount is the lock information, byte type paramesis NumfreeHandle is The number of free XMS memory sessions, byte type change parameters return value If the information block has been returned to True, otherwise returns false 10.XMS_MOVE Function Function Move Dunction Inclusion Block Usage XMS_MOVE (VAR EMB: EMBSTRUC) Result Type Boolean Description EMB is the variable of the EMBSTRUC type, returns the value of the parameter block of memory, if the data transfer between the memory is successfully returned, otherwise returns False 11.Hma_alloc function function Assign high memory area HMA_alloc (size: word) Result Type Boolean Size to allocate the size of the memory, the word value parameter return value If the assignment is successfully returned to true, otherwise return false 12.Hma_Free function function Release high memory area HMA_FREE results Type Boolean return value release successfully returned true, otherwise returning false 13. RALTER_A20 Function Function Function A20 Address Line Usage ALTER_A20 (FUNC: BYTE) Result Type Boolean Description FUNC can be used in the four constants defined on the single header, byte type value gauge, if the A20 address line is successfully executed Operation Returns True, otherwise returns false 14.A20_STAT Function Function Query A20 Address Line Status A20_STAT Result Type Boolean return value query successfully returns true, otherwise returns false 15.umb_alloc function function Assign the upper memory block (UMB) UMB_alloc (var psize, segaddr: word) result Type Boolean Description PSize is the size of the UMB designed to be allocated, with a Kb meter, a word type Segaddr assigned UMB Segment address, the word change parameter return value If the assignment is successfully returned to True, otherwise returns FASLE 16.umb_free Function Function Release The Assigned Upper Memory Block (UMB) UMB_FREE (Segaddr: Word) Result Type Boolean SEGADDR assigns a segment address return value if the release is successfully returned, otherwise returns Flase §2.7.3 Use of XMS unit XMSDemo.Pas demonstrates the usage of most of the XMS unit. The XMS_test is first detected whether the XMM exists. If there is a version number that calls XMS_STAT to take the XMM, and the XMS memory allocation status is taken, it finally demonstrates how to pass data to the outgoing XMS memory. The reader can use this demonstration to prepare your own programs that use expanded memory. §2.7.4 Source Procedure List Program 1: xms.pas {********************************************} {unit: xms} { Written by dong zhanshan} {version: Aug. 1994} {******************************************* Unit XMS; Interface TYPEXMS_STATUS = RecordVersion, Revision: Word; HMA_EXIST: BOOLEAN; END; XMS_MEM_STAT = RecordLargestBlock, TotalFreeMemory: Word; End; Source; CONSTGLOBALENABLEA20 = 00; GlobalDisablea20 = 01; Localenablea20 = 02; Localdisablea20 = 03; function XMS_test: boolean; procedure XMS_stat (var stat: XMS_status); function XMS_avail (var MemStat: XMS_mem_stat): boolean; function XMS_alloc (KSize: word; var Handle: word): boolean; function XMS_realloc (KSize, Handle: word): boolean; function XMS_free (Handle: word): boolean; function XMS_lock (Handle: word; var MyAddr: LongInt): boolean; function XMS_unlock (Handle: word): boolean; function XMS_bstat (Handle: word; var LockCount, NumFreeHandle: byte ): boolean; function XMS_move (var EMB: EMBstruc): boolean; function HMA_alloc (Size: word): boolean; function HMA_free: boolean; function Alter_A20 (Func: byte): boolean; function A20_stat: boolean; function UMB_alloc (var PSize , Segaddr: Word): Boolean; Function Umb_free (segaddr: word): boolean IMPLEMENTATION Uses dos; VARXMS_CONTROL: POINTER; {$ L xms.obj} Function XMS_TEST: BOOLEAN; Procedure xms_stat (var stat: xms_status); external; Function XMS_AVAIL (VAR Memstat: XMS_MEM_STAT): Boolean; External Function XMS_alloc (Ksize: Word; Var Handle: Word): Boolean; External Function XMS_Realloc (Ksize, Handle: Word): boolean; External; Function XMS_Free (Handle: Word): Boolean; External; Function XMS_LOCK (Handle: Word; Var myaddr: longint): boolean; external Function XMS_Unlock (Handle: Word): Boolean; External Function XMS_BSTAT (HANDLE: WORD; VAR LOCKCOUNT, NUMFREEHANDLE: BYTE): Boolean; External Function XMS_Move (var EMB: EMBSTRUC): boolean; External Function hma_alloc (size: word): boolean; external; function hma_free: boolean; Function alter_a20 (func: byte): boolean; external; Function A20_STAT: Boolean; EXTERNAL; Function umb_alloc (var psize, segaddr: word): boolean; external Function umb_free (segaddr: word): boolean; external; End. Program 2: xms.asm; xms.asm 1.0; buy by xms.pas Title Xmslocals @@ dosseg.model tpascal EXTRN XMS_CONTROL: DWORDEXTRN ERRORSTATUS: BYTE .Codeassume cs: @code Function XMS_Test Public XMS_Test XMS_TEST: PUSH BPMOV BP, SPMOV AX, 4300HINT 2FHCMP AL, 80HJNZ @@ 1mov AX, 4310HINT 2FHMOV WORD PTR XMS_CONTROL, BXMOV WORD PTR XMS_Control 2, ESMOV Al, 01JMP @@ 2 @@ 1: MOV Al, 0 @@ 2 : MOV SP, BPPOP BPRETF Procedure XMS_STAT Public XMS_STAT XMS_STAT: PUSH BPMOV BP, SPMOV AH, 0CALL XMS_CONTROLLES SI, [BP 6] MOV ES: [Si], Axmov ES: [Si 2], BXMOV ES: [Si 4], DLPOP BPRETF 04 Function XMS_AVAIL Public XMS_AVAIL XMS_AVAIL: PUSH BPMOV BP, Spmov AH, 8Call XMS_Controlles Si, [BP 6] MOV ES: [Si], AXMOV ES: [Si 2], DXMOV Errorstatus, BlPop BPRETF 04 Function XMS_alloc Public XMS_alloc XMS_alloc: Push BPMOV BP, SPMOV AH, 9MOV DX, [BP 0AH] Call XMS_Controlles Si, [BP 6] MOV ES: [Si], DXMOV ERRORSTATUS, BLPOP BPRETF 06 Function XMS_Realloc Public XMS_Realloc XMS_Realloc: Push BPMOV BP, SPMOV AH, 0FHMOV BX, [BP 8] MOV DX, [BP 6] Call XMS_Controlmov Errorstatus, BlPop BPRETF 4 Function XMS_LOCK Public XMS_LOCK XMS_LOCK: PUSH BPMOV BP, SPMOV AH, 0chmov DX, [BP 0AH] Call XMS_Controlles Si, [BP 6] MOV ES: [Si], BXMOV ES: [Si 2], Dxmov Errorstatus, BLPOP BPRETF 06 Function XMS_Unlock Public XMS_Unlock XMS_UNLOCK: PUSH BPMOV BP, SPMOV AH, 0DHMOV DX, [BP 6] Call XMS_Controlmov Errorstatus, BlPop BPRETF 02; Function XMS_BSTAT Public XMS_BSTAT XMS_BSTAT: PUSH BPMOV BP, SPMOV AH, 0EHMOV DX, [BP 0EH] Call XMS_Controlles Si, [BP 0AH] MOV BYTE PTR ES: [Si], Bhles Si, [BP 6] MOV BYTE PTR ES: [Si ], BLMOV ERRORSTATUS, BLPOP BPRETF 0AH Function XMS_MOVE Public XMS_MOVE XMS_Move: Push BPMOV BP, SPXOR BX, BXMOV AH, 0BHPUSH DSPOP ESPUSH DSLDS SI, [BP 6] CALL ES: XMS_ControlPop DSMOV ERRORSTATUS, BLPOP BPRETF 04 Function XMS_Free Public XMS_Free XMS_Free: Push BPMOV BP, SPMOV AH, 0AHMOV DX, [BP 6] Call XMS_Controlmov Errorstatus, BlPop BPRETF 02 Function HMA_alloc Public HMA_alloc HMA_alloc: Push BPMOV BP, SPMOV AH, 1MOV DX, [BP 6] Call XMS_Controlmov ErrorStatus, BlPop BPRETF 02 Function HMA_Free Public HMA_Free HMA_Free: Push BPMOV BP, Spmov AH, 2Call XMS_Controlmov Errorstatus, BlPop BPRETF Function alter_a20 Public ALTER_A20 Alter_a20: Push BPMOV BP, Spmov AH, [BP 6] Add Ah, 3Call XMS_Controlmov ErrorStatus, BLPOP BPRETF 2 Function A20_STAT Public A20_STAT A20_STAT: Push BPMOV BP, Spmov AH, 7Call XMS_Controlmov Errorstatus, BlPop BPRETF Function UMB_alloc Public UMB_alloc UMB_alloc: Push BPMOV BP, SPMOV AH, 10HLES SI, [BP 0AH] MOV DX, ES: [Si] Call XMS_Controlor AX, Axjz @@ 5 Go, [BP 6] MOV ES: [Si], BX @@ 5: Les Si, [BP 0AH] MOV ES: [Si], DXMOV ERRORSTATUS, BLPOP BPRETF 08 Function UMB_Free Public UMB_Free UMB_Free: Push BPMOV BP, SPMOV AH, 11HMOV DX, [BP 6] Call XMS_Controlmov ErrorStatus, BLPOP BPRETF 2 end Program 3: xmsdemo.pas {---------------------------------} {xmsdemo.pas} {DEMONSTRATES The usage of xms} {written by dong zhanshan} {version: Aug. 1994} {------------------------------- ----} XMSDemo; Uses XMS; Var Stat: Xms_status; memstat: xms_mem_stat; handle: Word; Emb: embstruc; i, ksize: integer; myaddr: longint; ar, ar1: array [1..1..1..1..10000] OF INTEGER; Beginif XMS_Test ThenbeginWriteln ('XMS Memory EXISTS'); XMS_STAT (STAT); Writeln ('XMS V', Hi (Stat.Version), 'XMM V', Hi (Stat.Revision), '. 0', LO (Stat .revision)); if XMS_Avail (memstat) thenwriteln ( 'lb =', memStat.LargestBlock, 'TFM =', memstat.TotalFreeMEmory); if XMS_alloc (16, handle) thenwriteln ( 'handle =', handle); if XMS_Avail (Memstat) ThenWriteln ('lb =', Memstat, MemStat.TotalFreeMemory; if Xms_free (Handle); if Xms_avail (Memstat) Thenwriteln ('lb =', MemStat.lagestBlock, 'TFM =', memstat.totalfreeMemory; if A20_stat then Writeln ('A20 is busy'); end; for i: = 1 to 10000 do ar [i]: = i; {for i: = 1 To 10000 do Write (Ar [i]: 5);} ksize: = sizeof (ar) DIV 1024; if ing odd (ksize) THEN INC (KSIZE); if Xms_alloc (Ksize, Handle) ThenbeginWriteln; Emb.count : = 1024; Emb.SourceHandle: = 0; Emb.DestinHandle: = Handle; for i: = 1 to ksize dobeginemb.destinofs: = (i-1) * 1024; Emb.SourceOfs: = longint (AddR (ar)) (i-1) * 1024; IF XMS_Move (EMB) Then; End; for i: = 1 to 10000 do ar [I]: = 0; Writeln (ErrorStatus); Emb.count: = 1024; Emb.SourceHandle: = Handle; Emb.DestinHandle: = 0; for i: = 1 to ksize dobeginemb.SourceOfs: = (i-1) * 1024; EMB.DESTINOFS: = longint (addr (ar)) (i-1) * 1024; if XMS_Move (EMB) Then; End; for i: = 1 to 10000 do Write (ar [i]: 5) Writeln (ERRORSTATUS); END; if xms_free (Handle) THEN WRITELN ('OK!'); END. ---------------------------------------------- you are a wind I am a sand, the forum is my home ps: "Sands" is my old id, "Shuimu Sand": = "Sands" newly registered a ID - Passbyword, or me. 2003-4-2 15:58:38 Sands Title: Webmaster Grade: Administrator Prestige: 2 Articles: 927 Points: 1863 School: Renewal: 2002-8-4 10th Floor §2.8 Mathematical Function Unit Math The MATH unit is a collection of mathematical functions and is a useful supplement to the Turbo Pascal mathematical function. It includes: taking symbol function, index function, logarithmic function, triangle and anti-triangular functions, maximum minimum function, arrangement and combined function, step-by-step function, etc. §2.8.1 Math function and process 1. Sign Function Function Method Sign Sign Sign (X: REAL) Result Type Integer Note X is a real number return value 1 or -1 2. Power function function Ask x 攩 Y agitating value Power (x, y: real) result type real profile X is the base, the real number; y is an index, the real return value X 攩 Y Dething 3.Log function function Qualifier Log (x, y: real) result type real type of LOG (X, Y: REAL) Result Type Real Description X is the number of logarithm, real numbers; y is the true number of logarithm, real return value log攭 Y value 4. AMAX function functions See the larger number of simultaneous numbers in two real numbers Amax (MXN1, MXN2: REAL) Result Type Imprint MXN1, MXN2 is a large number of large numbers in two real numbers 5.Amin function function See the smaller number of real numbers amin (MXN1, MXN2: REAL) result type type realmement meaning with a smaller number of AMAX returns 6.max function function, two integers, large number of numbers Max (MXN1, MXN2: longint) result type long integer, MXN1, MXN2 is two long intense returns value two integers 7.MIN function function, two integers, smaller numbers MIN (MXN1, MXN2: longint) result type long integer specification parameter meaning with MAX return value two integers smaller 8.Tan Function Function The Positive Split Function Type Tan (X: REAL) Result Type Type X is the angle value, with the correct function value of the angular angle X with radian 9. cTan Function Function Encutor X The remaining cut function value type CTAN (X: REAL) Result Type Type X is the angle value, the remainder value value of the angular X X 10.arcsin function function X number X The anti-sinus string function value ARCSIN (X: REAL) Result Type Type Type X is an anti-sinus string function value of the number X of the number X in the [-1, 1] interval, with radians meter 11. The RACCOS function function X number of anti-hind function value usage arcos (x: real) Result Type Type Type X is the remaining sinusoid function value of the number X of the number X in the [-1, 1] interval, with radiative meter 12.COMB function function, combination C, N 攭攩 m agitated value Comb (n, m: word) result type long integer setting N, M is two positive integers, M is smaller than n return value combination C to take N 攭攩 m Dething 13. The permut function function is arranged in the P-N 攭攩 M stirred value permut (n, m: word) result type long integer indication N, M is two positive integers, m is smaller than n return value arrangement P to take N 攭攩 m Dething 14.Factor function function See the intestinal N: Word's result of the Factor (N: WORD) result type long integer, N as the integer return value positive integer N level of multiplication value 2.8.2 Math MathDemo.Pas demonstrates the use of Math units, which calls the anti-triangular function ArcSin and ArcCOS and LOG functions, printed the function table of three functions. §2.8.3 Source Procedure List Program 1: math.pas {*********************************************} {unit: Math} {mathematics functions unit} {Written by dong zhanshan} {version: june 1994} {******************************** *********} Unit Math; (* {$ D-, S -} *) Interface Function Power (x, y: real): real; function log (x, y: real): real; function Amax (mxn1, mxn2: real): real; {fortran 77 function Function Amin (mxn1, mxn2: real): real; {fortran 77 function} Function max (mxn1, mxn2: longint): longint; {FORTRAN 77 function} function min (mxn1, mxn2: longint): longint; {Fortran 77 Function}: real; function ctan (x: real): real; function arcsin (x: real): real; function arcos (x: real): real; function comb (n, m: word : longint; function permut (n, m: word): longint; function factor (n: word): longint IMPLEMENTATION "{Get the Sign of a real} beginif x> = 0 THEN SIGN: = 1 else Sign: = -1; Begintan: = SIN (X) / COS (X); END; Beginctan: = COS (x) / sin (x); end; Function arcsin (x: real): real; {arcsin (x) = Arctan (x / 1-x)} var o: real; begino: = abs (x); if o> 1.0 Then Writeln ('Illegal Arguement '); if o = 1.0 tell x <0.0 the arssin: = -0.5 * Pielse Arcsin: = 0.5 * Pielse Arcsin: = Arctan (X / SQRT (1.0 - x * x)); "x: real): = (0.5 * pi) - arcsin (x) end; Function Amax (MXN1, MXN2: REAL): REAL; beginamax: = mxn1; if mxn2> mxn1 Then AMAX: = mxn2; Function Amin (MXN1, MXN2: Real): real; beginamin: = mxn1; if mxn2nd; function max; beginmax: = mxn1; if mxn2> mxn1 the max: = mxn2; IF mxn2nd; if MXN2END; BeginLog: = Ln (Y) / Ln (x); Function Poweri (X: REAL): Real; Function rlscan (x: real; n: integer): Real; Vary, Z: Real;: boolean; bign: integer; beginbign: = n; y: = 1.0; z: = x; while bign> 0 dobegino: = odd (bign); Bign: = Bign Div 2; if o thnbeginy: = y * z; rlscan: = y; end; z: = z * z; End ; END; (* func rlscan *) Beginif n> 0 ThenPoweri: = rlscan (x, n) elseif (x <> 0.0) and (n <0) Thenbeginn: = -n; Poweri: = 1.0 / rlscan (x, n); endelseif (n = 0) AND (x <> 0) ThenPoweri: = 1.0ELSEIF (n = 0) and (x = 0) ThenbeginWriteln ('0 to the 0 power.'); Poweri: = 0.0; endelseif (n <0) and (x = 0) THENBEGINWRITELN ('Division By Zero.'); Poweri: = 0.0; End; End; (* function poweri *) Function Power (X, Y: REAL): REAL; Beginif (Y) and (ABS (Y) <= 32767) ThenPower: = Poweri (x, trunc (y)) Elseif x> 0 ThenPower: = Exp (Y * ln (x)) Elseif x <0 dam ('x <0.'); Power: = 0.0; endelseif (x = 0) and (y = 0) THEN BeginWriteln ('0 to the 0 Power '); Power: = 0.0; endelseif (x = 0) AND (Y <0) THEN BEGINWRITELN (' 0 to a NEGATIVE POWER. '); Power: = 0.0; endelsepower: = 0.0; end; {End of function Power} Function factor; {this is a subroutine to calculte the fact;} var i: integer; x1: longint; beginx1: = 1; for i: = 1 to n DO x1: = x1 * i; factory : = X1; END; Function permut; {this is a subroutine to calculte the permutation}} var x1: longint; i: integer; beginx1: = 1; for i: = 1 to m do x1: = x1 * (n- i 1); permut: = x1; end; function comb; {this is a subscripter to calculte the combination} {of two integer Number.} var x1, x2, x3, i: longint; beginx3: = 1; IF m> (nm)) Thenbeginx1: = m; x2: = nm; endelsebeginx1: = nm; x2: = m; end; for i: = 1 to x2 DO x3: = x3 * (N-I 1); x1 : = Factor (x2); COMB: = X3 DIV x1; End. Program 2: MathDemo.pas {---------------------------------} {mathDemo.pas} {DEMONSTRATES The usage of maath} {Written by dong zhanshan} {version: june 1994} {---------------------------------------------------------------------------------------------------------- ---} {$ F } Program MathDemo; Uses astr, math; TYPEFUNC = Function (A: REAL): REAL; {DECLEARE FUNCTION TYPE} Procedure Printarctriangletable (Proc1: Func); VARI, J: Integer; Begini: = 0; REPEATFOR J: = 1 to 5 dobegininc (i); Write (Realtostr (I / 100, 5, 2), '|'); Write (Realtostr (Proc1 (I / 100) / PI * 180, 6, 3), Space (2)); End; Writeln; Until i = 100; Procedure Printlog; VARI, J: Integer; Begini: = 0; Repeatfor J: = 1 to 5 dobegininc (i); WRITE (WordTostr (I, 4), '|'); Write (Realtostr (log (10, i), 6, 4), Space (2 )))); end; Writeln; Until i = 1000; beginWriteLn ( 'ArcSin Table x | degree'); PrintArcTriangleTable (ArcSin); Writeln; WriteLn ( 'Arccos Table x | degree'); printArcTriangleTable (ArcCos); Writeln; Writeln ( 'Log10 (x) Table x | log10 (x) '); Printlog; end. §2.9 Matrix Computing Unit Matrix The Matrix unit contains 12 processes and functions, processing matrices, minus, multiplier, reverse, transposition, etc., to extend the matrix calculation function for Turbo Pascal. Matrix defines a matrix maximum element constant MaxNummateLement, and simultaneously defines three new types related to matrices, namely matrix element type MAXMATTYPE, maximum matrix type Maxmattype, and maximum matrix pointer type Maxmatptr. §2.9.1 Matrix function and process 1.matMaxElement function function MATMAXELEMENT function function Matrix Maximum element usage MatmaxElement (Mata: Pointer; N, M: Integer) Result Type Type Type Mata is the specified matrix, no type pointer variable N is matrix MATA The number of rows m is the maximum element of the number of columns of matrix MATA. 2. Matzero process function constructs a full zero matrix method Matzero (Mata: Pointer; N, M: INTEGER) Speaking of the parameters meaning with matMaxelement 3. Matcon process function structure constant matrix usage Matcon (Mata: Pointer; N, M: Integer) Speaking of the meaning of the parameters and matMaxelement 4. Matidn process function constructing unit matrix method Matidn (MATA: POINTER; N: INTEGER) 5. MATEQUAL process function matrix equal arithmetic method MATEQUAL (MATA, MATB: POINTER; N, M: Integer), MATA, MATB is the specified matrix, and there is no type of pointer variable N is the number of rows of rows m matrix. 6.MATADD Procedure Moment Matrix Equipment Method MATADD (MATA, MATB, MATC: POINTER; N, M: Integer) Description Mata, MATB is the specified matrix, and there is no type of pointer variable MATC for the result matrix added by MATA and MATB. None type pointer variable n is the number of rows m matrix M for matrix. 7. MatSub Process Function Matrix Slow Method MatsuB (MATA, MATB, MATC: POINTER; N, M: Integer) Description Mata, MATB is the specified matrix, and there is no type of pointer variable MATC for MATA and MATB reduction result matrices. None type pointer variable n is the number of rows m matrix M for matrix. 8. MatmulConst Process Function Constant MatmulConst (MATA: POINTER; C: REAL; N, M: POINTER; C: REAL; N, M: POINTER; C: REAL; N, M: Integer) Description Mata is the specified matrix, the number of rows of constant N as the matrix of constant N M column number of matrices 9.MATMUL process function matrix multiplier calculation method MATMUL (MATA, MATB, MATC: POINTER; N, M, O: Integer) Description Mata, MATB is the specified matrix, and there is no type of pointer variable MATC for MATA and MATB. Matrix, non-type pointer variable N is the number of rows of matrix MATA M as matrix MATA, the number of rows of matrix MATB is the number of columns of matrix MATB 10.MatTRAN Process Function Matrix Transmission Box Mattran (MATA, MATB: POINTER; N, M: INTEGER) Description Mata is a specified matrix, and there is no type of pointer variable MATB for the transposition matrix, and there is no type of pointer variable N is matrix MATA. The number of rows m is the number of matrices MATAs 11. Matinv Process Function Matinv (MATA, MATB: POINTER; N: Inteder) Speaking Mata is the specified square, there is no type of pointer variable MATB is inverse matrix, and there is no type of pointer variable N is the order of matrix MATA. 12.Deteval Function Function Qualification Specify the value of the value of the corresponding row, Deteval (MATA: POINTER; N: Integer) Result Type Implement Description Mata is the specified square, the non-type pointer variable N is returned to the order of the square matrix MATA Value value 2.9.2 MATRIX Matrdemo.Pas demonstrates the use of the Matrix unit part of the MATRIX unit. The process provided by the Matrix unit constructs a general-purpose process linequsol, and the reader can use the process to construct your own program. §2.9.3 Source Program List 1: Matrix.pas {****************************************** {MATRIX Procedure Unit} {Written By Dong ZHANSHAN} {Version: June 1994} {**************************** ********} Unit Matrix; {THIS UNIT INCLUDES 12 Subroutines on Matrix. You} {can use it to do your work. Interface CONSTMAXNUMMATELEMENT = 10000; typeMatElementType = Real; maxmattype = array [1..maxnummatelement] of mattptr = ^ MaxmatType; Function matMaxElement (MATA: POINTER; N, M: PROCEDURE MATZERO (MATA: POINTER; N, M: INTEGER); Procedure Matcon (MATA: POINTER; N, M: Integer); Procedure Matidn (Mata: Pointer) N: integer; Procedure Matequal; N, M: Integer; Procedure Matadd (MATA, MATB, MATC: POINTER; N, M: Integer); Procedure Matsub (Mata, Matb, Matc: Pointer , N, M: Integer; Procedure Matmulconst (Mata: Pointer; C: Real; N, M: Integer; Procedure Matmul (MATA, MATB, MATC: POINTER; N, M, O: Integer; Procedure Mattran (Mata) , MATB: POINTER; N, M: Integer; Procedure Matinv (MATA, MATB: POINTER; N: Integer); Function Deteval (MATA: POINTER; N: INTEGER): REAL IMPLEMENTATION Function matMaxElement; var p1: maxmatptr; i, j: integer; max: real; beginp1: = maata; max: = 0; for i: = 1 to n DOFOR J: = 1 to m doif ABS (P1 ^ [(i -1) * m j])> maxThen max: = ABS (p1 ^ [(i-1) * m j]); MatmaxElement: = max; end; Procedure matd; var p1, p2, p3: maxmatptr; i, j, l1: integer; beginp1: = maata; p2: = mATB; p3: = matc; for i: = 1 to n DOFOR J: = 1 To m dobeginl1 : = (i-1) * m j; p3 ^ [l1]: = p1 ^ [l1] p2 ^ [l1]; end; PROCEDURE MATSUB; VAR P1, P2, P3: Maxmatptr; I, J, L1: Integer; Beginp1: = Mata; P2: = MATB; P3: = Matc; for i: = 1 to n DOFOR J: = 1 To M DOBEGINL1 : = (i-1) * m j; p3 ^ [l1]: = p1 ^ [l1] - p2 ^ [l1]; end; end; procedure matmul; var p1, p2, p3: maxmatptr; i, j , K, L1, L2, L3: INTEGER; beginp1: = maata; p2: = matb; p3: = matc; for i: = 1 to n * o do p3 ^ [i]: = 0; for i: = 1 To N DOFOR J: = 1 To M DOFOR K: = 1 to o DOBEGINL1: = (i-1) * m J; L2: = (J-1) * O K; L3: = (i-1) * O K; P3 ^ [L3]: = P3 ^ [L3] P1 ^ [L1] * p2 ^ [l2]; end; Procedure mattran; var p1, p2: maxmatptr; I, j, l1, l2: integer; beginp1: = maata; p2: = matb; for i: = 1 to n DOFOR J: = 1 to m dobeginl1: = (i- 1) * m j; L2: = (j-1) * n i; p2 ^ [l2]: = p1 ^ [l1]; end; end; Procedure Matequal; Var P1, P2: Maxmatptr; I, J, L1: Integer; Beginp1: = Mata; P2: = MATB; for i: = 1 to n DOFOR J: = 1 To M DOBEGINL1: = (i-1) * m j; p2 ^ [l1]: = p1 ^ [l1]; end; Procedure matzero; var p1: maxmatptr; I, j, l1: integer; beginp1: = maata; for i: = 1 to n DOFOR J: = 1 to m dobeginl1: = (i-1) * m j; p1 ^ [l1]: = 0; end; end; Procedure matcon; var p1: maxmatptr; i, j, l1: integer; beginp1: = maata; for i: = 1 to n DOFOR J: = 1 to m dobeginl1: = (i-1) * m j; p1 ^ [l1]: = 1; END; Procedure matidn; var p1: maxmatptr; I, j, l1: integer; beginp1: = maata; for i: = 1 to n DOFOR J: = 1 to n Dobeginl1: = (i-1) * n j; if i = j THEN P1 ^ [L1]: = 1ELSE P1 ^ [L1]: = 0; end; Procedure matmulconst; var p1: maxmatptr; I, j, l1: integer; beginp1: = maata; for i: = 1 to n DOFOR J: = 1 to m dobeginl1: = (i-1) * m j; p1 ^ [L1]: = C * P1 ^ [L1]; End; End; Procedure Matinv; Var P1, P2: Maxmatptr; I, J, K: Integer; W, S: REAL; (******** ********************************************) Procedure TRANS (N1, N2: integer; var i, j: integer; beginfor i: = n1 to n2 dobegins: = p2 ^ [i] / w; for j: = 1 to k -1 dop1 ^ [(i - 1) * n J] - s * p1 ^ [(k - 1) * n j]; if i = k THEN P1 ^ [(i - 1) * n K]: = 1 - SELSE P1 ^ [(i - 1) * n k]: = - s; end; end; {**** * {********} (********* ********** Begin matinv *********************) Beginmatequal (MATA, MATB, N, N); P1: = MATB GetMem (p2, n * n * sizeof (matlementtype)); for i: = 1 to n DOP1 ^ [(i - 1) * n i]: = p1 ^ [(i - 1) * n i] - 1; for K: = 1 to n Dobeginfor i: = 1 to n Dobeginif i Function deteval; var p1, p2: maxmatptr; i, j, k, l: integer; p, t, u: real; label out; beginp1: = maata; getmem (p2, n * n * sizeof (matlementtype)); For i: = 1 to n Dobeginu: = 0; for j: = 1 to n DOIF ABS (P1 ^ [(i-1) * n j])> uThen u: = ABS (P1 ^ [(i-1 * n j]); if u <10e-20 damimegindeteval: = 0; goto output; end; p2 ^ [i]: = u; if u <> 1 thenfor J: = 1 to n DOP1 ^ [(i -1) * n j]: = p1 ^ [(i-1) * n j] / u; end; p: = 1; fork: = 1 to n -1 dobeginl: = k; T: = ABS (p1 ^ [(k-1) * n k]); for j: = k 1 to n DOIF T Program 2: matdemo.pas {---------------------------------} {matonstrates The usage of matrix} {written by dong zhanshan} {version: june 1994} {------------------------------------------------------------------------------------------------------------------ ---} Program MatrixDemo; Uses astr, matrix; CONSTMN = 3; mm = 1; m1: array [1..mn, 1..mn] of matlementtype = (1, 1, 1), (1, -1, 1), (1, 1, -1) )); m2: array [1..mn, 1..mm] of matlementtype = ((5), (6), (4)); Varm3: array [1..mn, 1..mm] of matlementtype; i, j: integer; Procedure Linequsol (MATA, MATB, MATC: POINTER; N, M: Integer); Varp1, P2, P3, P4: Maxmatptr; Beginp1: = MATA; P2: = MATB; P3: = Matc; GetMem (p4, n * n * Sizeof (matinv (P1, P4, N); Matmul (P4, P2, P3, N, N, M); FreeMem (p4, n * n * sizeof (matlementtype)); end; beginwriteln (' THIS IS A DEMONSTRATION Program for Matrix Unit '); Writeln (' Linear Equation: '); for i: = 1 To Mn Dobeginfor J: = 1 To Mn - 1 Dowrite (' (', Realtostr (M1 [i, j] , 2, 0), ')', CHR (119 J), ' '); INC (J); Write ('(', realtostr (m1 [i, j], 2, 0), ')' , CHR (119 J), '='); WRITOSTR (M2 [i, 1], 2, 0)); end; linequsol (@ m1, @ m2, @ m3, mn, mm); Writeln 'Solution:'); for i: = 1 to Mn Dowriteln (Space (5), CHR (119 I), '=', Realtostr (M3 [i, 1], 4, 1); Writeln; End. §2.10 Probability Distribution Function Unit Prob This unit gives a variety of common probability distributions, such as the probability accumulation functions of the F distribution, T distribution, X 攩 2 stirring distribution, making the statistical testing process in probability statistical analysis and is easy to travel, and it is very easy to automate. §2.10.1 Function defined by the Prob unit 1.Finv function function is based on a given α value and free degree value, the FINV (Alpha, DFN, DFE: REAL) result type real shape, the only type, the DFN, DFE is the freedom of F distribution Return value f value 2. Sigf function function calculates its probability value usage SIGF (F, DFN, DFD: REAL) results type real shape, DFN, and DFDs F, DFN and DFDs F, DFN, and DFD, based on a given degree of freedom and f value. Distributed freedom value return value probability value 3.TINV function function According to the given α value and free degree value, the T value type TINV (Alpha, DF: REAL) result type type is illustrated by ALPHA as a significant probability, and DF is the degree of freedom returns T distribution. value 4. Thesigt function function calculates its probability value usage Sigt (T, DF: REAL) result type type real shape, and the DF is the degree of freedom return value for the T distribution. Probability value 5.sigchi function function calculates its probability value usage Sigchi (Chisq, DF: REAL) result type in accordance with a given degree of freedom and X 攩 2 aggregation value, CHISQ is the value of the probability, DF is X 攩 2 Distributed degree of freedom return value probability value §2.10.2 Use of Prob unit PROBDEMO.PAS demonstrates the use of the FINV function of the Prob unit, which prints the F-distribution of the F-distribution within 100 DF1 and DF2. §2.10.3 List of Source Procedures Program 1: prob.pas {*******************************************} {unit: prob} { Written by dong zhanshan} {version: Oct. 1991} {**************************************************** {$ N , E } Unit Prob; Interface Uses math; Function Finv (Alpha, DFN, DFE: Real): Real; Function Sigt (T, DF: REAL): REAL; Function TINV (Alpha, DF: REAL): REAL; Function SIGF (F, DFN, DFD: REAL): Function Sigchi (CHISQ, DF: REAL): REAL IMPLEMENTATION CONSTPI = 3.141592653589793 {Math constant PI}; Xln2sp = 9.18938533204673E-01 {LogE (Sqrt (2 * PI))}; Rmax = 1.67E 37 {Maximum flt pt number}; Rsmall = 4.19E-37 {Smallest flt pt Number}; rinf = 1.67e 37 {machine "infinity"}; zeta = 1.0e-16}; maxprec = 16 {max. precision}; sqrt2 = 1.4142135623730950 {Square root of 2}; lntenInv = 0.4342944819032520 {1 / ln (10)}; LNTWO = 0.6931471805599450 {ln (2)}; Function ERF (Z: REAL): REAL; CONSTA: ARRAY [1..14] OF real = (1.1283791670955,0.34197505591854,0.86290601455206E-1,0.12382023274723E-1,0.11986242418302E-2,0.76537302607825E-4,0.25365482058342E-5, -0.99999707603738, -1.4731794832805, -1.0573449601594 , -0.44078839213875, -0.100684197950781, -0.12636031836273E-1, -0.1149393366616E-88); B: ARRAY [1..12] OF real = (-0.36359916427762,0.52205830591727E-1, -0.30613035688519E-2, -0.46856639020338E -4, 0.15601995561434E-44, -0.62143556409287E-6, 2.601534994799, 2.9929577558884, 0.79250795276064, 0.223968828335053E-1) VARU, X, S: REAL; Begin {ERF} x: = ABS (z); if z> = 0.0 Then S: = 1.0ELSE S: = -1.0; if (z = 0.0) Then Erf: = 0.0ELSE IF (x> = 5.5) Then Erf : = SELSEBEGINU: = x * x; if (x <= 1.5) Thenerf: = (x * exp (-u) * (a [1] u * (a [2] u * (a [3] U * (a [4] u * (a [5] u * (a [6] u * a [7]))))))))))) / (1.0 u * (B [1] U * (B [2] U * (B [3] U * (B [4] U * (B [5] U * B [6]))))))))))))))))))))))))))))))))))))) -U) * (a [8] x * (a [9] x * (a [10] x * (a [11] x * (a [12] x * (a [13] X * a [14]))))))))) / (1.0 x * (B [7] x * (B [8] X * (B [9] X * (B [10] x * (B [11] x * b [12])))))))))) 1.0) * s; end; end {erf}; function algama (arg: real): real; constp: array [1 .. 29] OF real = (4.12084318584770E 00, 8.56898206283132E 01, 2.43175243524421E 02, -2.61721858385614E 02, -9.222613728801552E 02, -5.17638349802321E 02, -7.74106407133295E 01, -2.208843997216118E 00, 5.15505761764082 E 00, 3.77510679797217E 02, 5.26898325591498E 03, 1.95536055406304E 04, 1.2043173809 8716E 04, -2.06482942053253E 04, -1.50863022876672E 04, -1.51383183411507E 03, -1.037701651732998E 04, -9.82710228142049E 05, -1.97183011586092E 07, -8.731675438238339E 07, 1.11938535429986E 08 , 4.81807710277363E 08, -2.44832176903288E 08, -2.40798698017337E 08, 8.06588089900001E-04, -5.94997310888900E-04, 7.93650067542790E-04, -2.77777777688189E-03, 8.333333333333300E-02); Q: ARRAY [1 .. 24] OF real = (1.00000000000000E 00, 4.56467718758591E 01, 3.77837248482394E 02, 9.51323597679706E 02, 8.46075536202078E 02, 2.62308347026946E 02, 2.44351966250631E 01, 4.09779292109262E -01, 1.00000000000000E 00, 1.28909318901296E 02, 3.03990304143943E 03, 2.20295621441566E 04, 5.71202553960250E 04, 5.26228638384119E 04, 1.44020903717009E 04, 6.98327414057351E 02, 1.00000000000000E 00, -2.01527519550048 E 03, -3.11406284734067E 05, -1.048577583049994E 07, -1.11925411626332E 08, -4.04435928291436E 08, -4.353707148043774E 08, -7.90261111418763E 07); VARRarg, Alinc, Scale, Top, Bot , FRAC, Algval: Real; I, IAPPROX, IOF, ILO, IHI: INTEGER; Qminus, qdoot: boolean Begirc: = RINF; scale: = 1.0; alinc: = 0.0; Frac: = 0.0; Rar: = arg; IOF: = 1; Qminus: = false; qdoot: = true; if (RARG <0.0) THENBEGINQMINUS: = true; rar: = -rarg; top: = int (rar); bot: = 1.0; IF ((INP / 2.0) * 2.0) = 0.0) THEN BOT: = -1.0; top: = rarg - Top; if (TOP = 0.0) Thenqdoit: = FalseelseBeginfrac: = BOT * PI / SIN (TOP * PI); RARG: = RARG 1.0; FRAC: = Ln (ABS (FRAC)); END; END; IF RARG = 0.0) Then qdoot: = false = false IF (RARG <= 0.5) Thenbeginalinc: = -ln (RARG); scale: = rar; rar: = rarg 1.0; if (Scale Function CDbeta (X, Alpha, Beta: Real; DPREC, MAXITER: INTEGER; VAR CPREC: REAL; VAR; ifault: integer: Real; Varepsz, A, B, C, F, FX, APB, ZM, ALO, Ai, BLO, BHI, BOD, BEV, ZM1, D1, AEV, AOD: REAL; NTRIES: INTEGER; QSWAP, QDOIT, QCONV: Boolean; Label 20, 9000; Begin {cdbeta} if DPREC> maxprec the dprec: = maxprecelse If DPREC <= 0 THEN DPREC: = 1; CPREC: = DPREC; EPSZ: = Power (10, -DPREC); x: = x; A: = alpha; b: = beta; qswap: = false; cdbeta: = -1.0; qdoot: = true; ifault: = 1; IF (x <= 0.0) THEN GOTO 9000; IF ((a <= 0.0) OR (B <= 0.0)) THEN GOTO 9000; cdbeta: = 1.0; ifault : = 0; if (x> = 1.0) THEN GOTO 9000; if (x> (A / (A B))) Thenbeginx: = 1.0 - x; A: = Beta; b: = alpha; qswap: = True ; End; if ((x = a) or (x = b)) THEN GOTO 20; if (a = ((((b * x) / (1.0 - x))) THEN GOTO 20; IF (ABS (A-) X * (a b))) <= epzz) THEN GOTO 20; C: = AlGama (A B) A * ln (x) b * ln (1.0 - x) - Algama (a) - algama ( B) -ln (a - x * (a b)); if ((c <-36.0) and qswap) THEN GOTO 9000; CDBETA : = 0.0; IF (c <-180.0) THEN GOTO 9000; 20: APB: = A B; ZM: = 0.0; AlO: = 0.0; BOD: = 1.0; bev: = 1.0; BHI: = 1.0; blo : = 1.0; AHI: = EXP (Algama (APB) A * LN (X) B * ln (1.0 - x) - Algama (A 1.0) -algama (b)); f: = AHI; iter: = 0; qConv: = false; Repeatfx: = f; zm1: = zm; zm: = zm 1.0; D1: = A ZM ZM1; AEV: = - (A ZM1) * (APB ZM1) * * X / D1 / (D1 - 1.0); AOD: = zm * (b - zm) * x / d1 / (d1 1.0); alo: = bev * ahi aev * alo; blo: = bev * BHI AEV * Blo; AHI: = BOD * ALO AOD * AHI; BHI: = BOD * BLO AOD * BHI; IF ABS (BHI) Function Betainv (P, Alpha, Beta: REAL; MAXITER, DPREC: INTEGER; VAR ITER: Integer; Var CPREC: REAL; VAR IERR: Integer: Real; Vareps, XIM1, XI, XIP1, FIM1, FI, W, CMPLBT , Adj, SQ, R, S, T, G, A, B, PP, H, A1, B1, EPREC: REAL; DONE: BOOLEAN; JTER: Integer; Label 10, 30, 9000; Begin {Betainv} Ierr: = 1; betAinv: = p; if ((alpha <= 0.0) or (beta <= 0.0)) THEN GOTO 9000; IF ((P> 1.0) OR (P <0.0)) THEN GOTO 9000; IF ((P = 0.0) OR (p = 1.0)) Thenbeginiter: = 0; cprec: = maxprec; goto 9000; end; if DPREC> maxprec the DPREC: = MAXPRECELSE IF DPREC <= 0 THEN DPREC: = 1; cprec: = DPREC; EPS: = POWER (10, -2 * DPREC); if (p> 0.5) THENBEGINA: = Beta; B: = alpha; pp: = 1.0 - p; endelsebegina: = alpha; b: = Beta; PP: = P ; End; Ierr: = 0; cmplbt: = algama (a) algama (b) - algama (A B); FI: = NINV (1.0 - PP); if ((A> 1.0) and (b> 1.0 )) Thenbeginr: = (FI * FI - 3.0) / 6.0; s: = 1.0 / (a a - 1.0); T: = 1.0 / (b b - 1.0); h: = 2.0 / (S T ); W: = FI * SQRT (h r) / h - (t - s) * (R 5.0 / 6.0 - 2.0 / (3.0 * h); xi: = A / (a b * exp (w w)); endelsebeginr: = b b; T: = 1.0 / (9.0 * b); T: = r * Power ((1.0 - t fi * SQRT (T)), 3); if (t <= 0.0) Thenxi: = 1.0 - Exp ((ln (((1.0 - pp) * b) cMPLBT) / b) Elsebegint: = (4.0 * a r - 2.0) / t; if (t <= 1.0) Thenxi: = Exp ((ln (pp * a) cmplbt) / PP) Elsexi: = 1.0 - 2.0 / (t 1.0); End; End; IF (xi <0.0001) THEN XI: = 0.0001; IF (xi> 0.9999) THEN: = 0.9999; A1: = 1.0 - a; b1: = 1.0 - b; fim1: = 0.0; sq: = 1.0; xim1: = 1.0; it: = 0; DONE: = false; repeatiter: = iter 1; Done: = DONE OR (Iter> Maxiter); FI: = CDbeta (xi, a, b , DPREC 1, Maxiter, EPREC, JTER, IERR B1 * ln (1.0 - xi)); IF ((FI * FIM1) <= 0.0) THEN XIM1: = SQ; G: = 1.0; 10: RepeatADJ: = g * fi; sq: = adj * adj; if (SQ> = XIM1) THEN G: = g / 3.0; Until (SQ Function Sigt: Real; constdprec = 12; Maxiter = 200; Variter, IFAULT: INTEGER; PVAL, CPREC: REAL; begin {sigt} PVAL: = -1.0; IF (DF> 0.0) ThenbeginPval: = CDBETA (DF / (DF T * T), DF / 2.0, 0.5, DPREC, MAXITER, CPREC, ITER, IFAULT); if iFault <> 0 THEN PVAL: = -1.0; end; sigt: = pval; end; {Sigt}; Function TINV (Alpha, DF: REAL): REAL; constMaxiter = 100; DPREC = 10; Vartin, CPREC: REAL; ITER, IERR: Integer; begin {tinv} alpha: = 1 - alpha; tin: = -1.0; if (DF> 0.0) Thenif (alpha <= 0.0) and (alpha <= 1.0)) Thenbegintin: = BetAinv (alpha, 0.5, df / 2.0, maxiter, dprec, it, cprec, Ierr); if ((tin> = 0.0) AND (Tin <1.0) and (Ierr = 0)) THENTIN: = SQRT (Tin * DF / (1.0 - tin)); end; tinv: = tin; end {tinv}; function gammain (Y, P : indeger; var CPREC: REAL; VAR ITER: Integer; var iFAULT: INTEGER: REAL; constoflo = 1.0e 37; minexp = -87.0; VARF, C, A, B, Term, GIN , AN, RN, DIF, EPS: REAL; PN: Array [1..6] of real; done: boolean; label 9000; begin {gammain} iFault: = 1; gammain: = 1.0; if ((Y <= 0.0) OR (P <= 0.0)) THEN GOTO 9000; ifault: = 0; F: = P * Ln (Y) - AlGama (P 1.0) - Y; IF (F = EPS) THENIF (DIF <= (EPS * RN)) THEN DONE: = true; gin: = rn; end; pn [1]: = PN [3]; PN [2]: = PN [4]; PN [3]: = PN [5]; PN [4]: = PN [6]; IF (ABS (PN [5])> = OFLO) THENBEGINPN [1]: = PN [1] / OFLO; PN [2 ]: = PN [2] / OFLO; PN [3]: = PN [3] / OFLO; PN [4]: = pn [4] / oflo; end; uter> maxiter) or done; GIN: = 1.0 - (f * gin * p); gammain: = gin; if Dif <> 0.0 TEN CPREC: = -log (10, DIF) Else CPREC: = maxPrec; endelsebegin {infinite series} @ = 0; term: = 1.0; C: = 1.0; A: = P; DONE: = false; Repeata: = a 1.0; Term: = Term * Y / A; C: = C Term; ore: = iTER 1; Until (iter > Maxiter) or (term / c) <= eps); gammain: = c * f; cprec: = -log (10, term / c); end; 9000: {error exit} end; {gammain} function sigchi (CHISQ, DF: REAL): REAL; constMaxiter = 200; DPREC = 12; varierr, item: integer; cprec: real; begin = 1.0 - gammain (Chisq / 2.0, DF / 2.0, DPREC, MAXITER , CPREC, ITER, IERR; IF (Ierr <> 0) THEN SIGCHI: = -1.0; end; {sigchi} Function CINV (P, V: REAL; VAR IFAULT: INTEGER): REAL; Conste = 1.0e-8; DPREC = 8; Maxiter = 100; VARXX, C, CH, Q, P1, P2, T, X, B, A, G, S1, S2, S3, S4, S5, S6, CPREC: REAL; ITER: INTEGER; Label 9000; Begin {CINV} CINV: = -1.0; ifault: = 1; IF (P 1278.0 * a))))) / 2520.0; S3: = (210.0 A * (462.0 932.0 * a))) / 2520.0; S4: = (252.0 1182.0 * a) C * (294.0 1740.0 * a))) / 5040.0; S5: = (84.0 264.0 * A C * (175.0 606.0 * a)) / 2520.0; S6: = (120.0 C * (346.0 127.0 * C)) / 5040.0; CH: = CH T * (1.0 0.5 * T * S1 - B * C * (S1 - B * (S2 - B * (S3 - B * (S4 - B * (S5 - B * S6))))))))))))))))); END; Until (ABS ((Q / CH) - 1.0) <= e) or (ifault <> 0); if iFault = 0 Then Cinv: = Chelse CINV: = -1.0; 9000:; End; {CINV} Function SIGF (F, DFN, DFD: REAL): REAL; ConstdPrec = 12; Maxiter = 200; Variter, iFault: Integer; PVAL, CPREC: REAL; begin { SIGF} pval: = -1.0; if (DFN> 0.0) and (DFD> 0.0) Thenbeginpval: = CDbeta (DFD / (DFD F * DFN), DFD / 2.0, DFN / 2.0, DPREC, MAXITER, CPREC, ITER , IFault); if iFault <> 0 THEN PVAL: = -1.0; end; sigf: = pVAL; END {sigf}; Function cdnorm (x: real): real; begin {cdnorm} if x> = 0.0 the cdnorm: = (1.0 ERF (X / SQRT2)) / 2.0ELSE cDNORM: = (1.0 - ERF (-x / sqrt2)) / 2.0; end; {cdnorm} Function Signorm (x: real): real; begin {sIgnorm} if x> = 0.0 Then Signorm: = 1.0 - (1.0 ERF (X / SQRT2)) / 2.0ELSE SIGNORM: = 1.0 - (1.0 - ERF (-x / SQRT2)) / 2.0; end; {sIGNORM} Function NINV2 (P: Real): Real; VARXP, P1, Z, X3, X2, X1, PHI: Real; Begin {Ninv2} XP: = Ninv (p); P1: = Signorm (XP); PHI: = SQRT (1.0 / (2.0 * pi)) * exp (xp * xp) / 2.0); z: = (p - p1) / pHI; x3: = (2.0 * (xp * xp) 1.0) * z / 3.0; x2: = (x3 xp) * z / 2.0; x1: = ((x2 1.0) * z); Ninv2: = XP x1; end; {ninv2} END. Program 2: provelemo.pas {----------------------------------} {provelemo.pas} {DEMONSTRATES The usage of prob} {written by dong zhanshan} {version: Aug. 1994} {------------------------------- ----} {$ N , E } Program provelemo; Uses prob; VAR I, J, K: Inteder; x, y, z: real; Begink: = 0; for i: = 1 to 100 DOFOR J: = 1 to 100 dobegininc (k); Write (Finv (0.05, i, j): 9: 3, '[', i: 3, ',' , J: 3, ']); if k = 4 damEgink: = 0; Writeln; end; end; end. §2.11 Complex Complex § 2.11.1 Overview In a general PASCAL textbook, the plural type and complex operation are defined as follows: Type complex = record real_part: real; image_part: real; Procedure CADD (x, y: complex; procedure csub (x, y: complex; var result: complex); Procedure Cmul (x, y: complex; var result: complex); Procedure CDIV (X, Y: Complex; Var Result: Complex; That is, the complex is designed to have a record type with real and imaginary parts, and its operation is completed, not the function of functions, which is due to the PASCAL language itself. In the Pascal language, the return type of a function can only be the basic data type, and cannot be a composite data type. With the above complex operation process, a disadvantage is that the calculation expression is not clear, and the second is to more auxiliary variables. The following describes a method of using the plurality of calculation functions written by the ABSOLUTE and string types. Turbo Pascal's ABSOLUTE reserved word, allowing a variable to share the same memory area with a defined variable, so that the same memory unit can be accessed in different ways. To apply the ABSOLUTE clause, define the following types: typeComplexr = Recordlen: byte; rp: real; ip: real; end; complexs = string [sizeof (real) * 2]; This can use ABSOLUTE to get ComplexR and Complexs. The internal operations returned with the COMPLEXS type with the COMPLEXR type, the external delivery parameter, and the function value. The complex calculation can be defined as: Function CADD (X, Y: ComplexR): Complexs; Function CSUB (X, Y: ComplexR): Complexs; Function Cmul (x, y: complexr): complexs; function CDIV (x, y: ComplexR): Complexs; this definition overcomes the shortcomings of the first definition. §2.11.2 Complex process and functions The unit defines two new data types, which is ComplexR and Complexs, and Complexs are the utility type of the Complex unit, and ComplexR is a private data type of the Complex unit, and five functions and 1 process are also defined. Two new data types have been told above, and the processes and functions are described below. 1.CADD function function Performs a complex addition operation method CADD (X, Y: ComplexR) result Type Complexs Speech X, Y is the value of the value of the value of the value complexs type 2. CSUB Function Function Performs a CSUB (X, Y: ComplexR) Result Type Complexs Speech X, Y is the value of the value of the value complexs type 3.cmul function function Performs a complex multiplication method CMUL (X, Y: ComplexR) Result Type Complexs Speech X, Y is the value of the value of the value complexs type 4. CDIV Function Function Performs a CDIV (X, Y: ComplexR) Result CDIV (X, Y: ComplexR) Result Type Complexs Speech X, Y is the value of the value of the Complexs type 5.CPLX function function constructs a new plural Method CPLX (X, Y: REAL) result type complexs Speech X, Y is the true value guanle value: the value of the complexs type 6.OCPLX Process Function Outputs a plural Method OCPLX (S: String; X: Complexs) §2.11.3 Use of Complex Unit The Compdemo.Pas program demonstrates the use of the Complex unit. The first use of the CPLX function constructed 4 multiple-fold types, then outputs them, and finally calls the Complex unit definition to add, subtract, multiply, divide, and output results. §2.11.4 Source Procedure List Program 1: Complex.Pas {*******************************************} {unit: complex} { Written by dong zhanshan} {version: Aug. 1994} {******************************************* Unit complex; interface constcomplexsize = sizeof (real) * 2; TypeComplexs = String [complexsize]; Function CADD (X, Y: Complex): Complexs; Function CSUB (X, Y: Complexs): Complexs; Function Cmul (x, y: complexs): complexs; function CDIV (x, y: complexs): complexs; function cplX (x, y: real): complexs; procedure oplx (s: string; x: complex); IMPLEMENTATION TypeComplexR = Recordln: Byte; {Length} rp: real; {real part} ip: real; {image part} end; Function Cadd; VART1: Complexs; C: ComplexR Absolute Y; D: ComplexR Absolute Y; T2: ComplexR Absolute T1; Begint2.ln: = COMPLEXSIZE; T2.RP: = C.RP D.RP; T2.IP: = C.IP D.IP; CADD: = T1; END; Function CSUB; VART1: Complexs; C: ComplexR Absolute Y; D: ComplexR Absolute Y; T2: ComplexR Absolute T1; Begint2.ln: = COMPLEXSIZE; T2.RP: = C.RP - D.RP; T2.IP: = C.IP - D.IP; CSUB: = T1; END; Function Cmul; Vart1: Complexs; C: ComplexR Absolute Y; D: ComplexR Absolute Y; T2: ComplexR Absolute T1; Begint2.ln: = COMPLEXSIZE; T2.RP: = C.RP * D.RP - C.IP * D .Ip; t2.ip: = C.IP * D.RP C.RP * D.IP; cmul: = T1; Function CDIV; VART1: Complexs; C: ComplexR Absolute Y; D: ComplexR Absolute Y; T2: ComplexR Absolute T1; P: Real; Begint2.ln: = COMPLEXSIZE; P: = D.RP * D.RP D.IP * D.IP; T2.RP: = (C.RP * D.RP C.IP * D.IP) / P; T2.IP: = (C.IP * D.RP - C.RP * D. IP) / P; CDIV: = T1; END; Function CPLX; VART1: Complex; T2: ComplexR Absolute T1; Begint2.ln: = COMPLEXSIZE; T2.RP: = X; T2.IP: = Y; CPLX: = T1; END; Procedure Ocplx; Vart: ComplexR Absolute X; BeginWriteln (S: 5, '=', T.RP: 10: 4, ' ', T.IP: 10: 4, 'I'); END; End. Program 2: compdemo.pas {----------------------------------} {compdemo.pas} { Demonstrates the usage of complex} {Written by dong zhanshan} {version: Aug. 1994} {------------------------------------------------------------------------------------------------------------------------------------ ------} Program ComplexDemo; Uses complex; Vara, B, C, D: complexs; Begina: = CPLX (2,5); B: = CPLX (3, 4); C: = CPLX (7, 5); D: = CPLX (10, 6); OCPLX ('A', A); OCPLX ('b', b); OCPLX ('c', c); OCPLX ('D', D); OCPLX ('A B', CADD (A, B)); OCPLX ('A * C', CMUL (A, C)); OCPLX ('A / B', CDIV (A, B)); OCPLX ('A-D', CSUB (A, D)); END. ---------------------------------------------- you are a wind I am sand, the forum is my home PS: "Sands" is my old ID, "water-wood sand": = "Snow people" newly registered a ID - Passbyword, or me. 2003-4-2 16:00:11 Sands Title: Webmaster Level: Administrator Prestige: 2 Articles: 927 Points: 1863 School: Anti-Japan Union Registration: 2002-8-4 Chapter III Utilities This chapter provides 12 utilities written with Turbo Pascal, including programs, lock drive logical partitions, program list printers, source program list programs, search and replacement, backup hard drive Guide record programs, Quad-PC text file two-way conversion program, SPT file, and BMP file two-way conversion program, database file card, Batch file is converted to a program of the COM file, the effective destruction of the confidential file, release the memory program, etc. 12 . The following is specifically described in the writing principle and method of use of each program. §3.1 soft lock driver program Generally 286 or 386 microcomputer has a large-capacity hard disk, which is convenient to use, installing many system software and dedicated software on the hard disk, and there are many applications developed by users, because the security of the DOS system is poor, software , Programs or data is often easily replicated by others. How can I prevent others from copying? People think of many methods, there is a way to add words to hard disk, making the subdirectory names into a variety of ways, introducing a copy of the anti-copy method that invalidates the logical drive. Suitable using the program provided in this section, after the computer is started from the hard disk, the floppy drive (including A, B drive) can be invalid, and when the C: /> hits A: and Enter, display "Invalid Drive" Specification, type B:, this information is also displayed. This is not allowed to copy programs and software when it is not allowed. §3.1.1 Getting the method of driver path table Getting the driver path table requires the DOS function call for the unchecked document to be called 52h. The use of the function call is to obtain a pointer to the internal buffer, the pointer pointing to the table describing most DOS internal structures related to the storage subsystem, return The pointer exists in ES: BX. The structure of this buffer varies from the main versions of DOS, to DOS3.xx and the above version, the offset 16H of this table is a far pointer to the drive path. The drive path table consists of multiple entries, each entry contains the default path, the head position, and various flags and pointers, the number of entries is equal to the number of effective logical drives plus 1, and the logo variable of the last entry is Zero, there is no useful data. The structure of the drive path entry is shown in Table 3-1. Table 3-1. Structure of the drive path entry - 殌─────────────────────────────────── │ │ shift length byte │├────┼─────┼───────────────────────┤│ 0 │ │ Description ASCIIZ format Current default path name, including logic driver ││ │ (64) │ │ │ │ │ │ │40H │ │ │ │ ││44H │ byte │ logo variable, all valid items contain a 40h, the last item contains 0 ││45H │ Double word │ Logical Drive Parameter Block Far Pointer ││49H │ Word │ This Logic Drive Current Block or Channel / Sector Number ││ 4BH │ Double word │ far pointer ││4fh │ word │ Unknown storage │ └ - ─ ────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────── ─ ┘ 殣┘ From Table 3-1, it is valid when a byte of each entry of each entry for each entry of the drive path table is valid. It is 40h when it is valid. It is ineffective for other values, so to logic The driver fail can be called 52H via the DOS function to modify this flag is 0. The author writes a program sl.PAS with Turbo Pascal and TASM, which can be used to modify the logical drive path table, causing the logical drive to fail and valid, and the source program is enclosed. §3.1.2 How to use The program uses command line format: SL [D:] [/ switch] where D represents the drive, Switch is a switch, can take L and u, and take the lock driver when it is taken, and unlock the locked drive when U Typical Usage: SL - Display Program Help Information SL C: Displays the current state of the C logic disk SL C: / L - Lock C Logic disk SL C: / U - Unlock C Logic Drug This program can only be Working under the operating system of MS DOS 3.0 or more. When unlocking the logical drive, the program prompts the password, the password set by the program is "abcdef", which can be found in the SoftLock.asm source program. §3.1.3 Role and Effect Prevent others from copying software, programs, or data. The invasion of viruses: Because non-machine managers cannot use floppy drives when they are not permitted, thereby reducing the opportunity of viral intrusion. The procedure has been very effective through my long-term use and reduces the invasion of viruses. Whenever the data is exchanged, we use the anti-virus software to disinfect the floppy disk, so that the virus is difficult to invade the system, which has a good effect on the security and data of the system. §3.1.5 Source Procedure List Program 1: sl.PAS {} {Sl.Pas 1.0} {CopyRight (c) 1991 dong zhenshan} Program Softlock; Var Drive, Switch: char; {$ L softlock}. PROCEDURE LOCKDRIVE; PROCEDURE UNLOCKDRIVE; EXTERNAL; Function getDrivenum: byte; Procedure Help; Beginwriteln ('Syntax: SL [D:] [/ Switch]'); Writeln ('Switch: / L = Lock The Drive D:'); Writeln ('/ u = UNLOCK The Drive D:'); Writeln ('Examples: SL - Display Help Text'); Writeln ('SL C: - Display The State of Drive C'); Writeln ('SL C: / L - Lock The Drive C'); Writeln 'SL C: / U - UNLOCK THE DRIVE C'); Writeln ('Note: Only Using In MS DOS 3.0 and OVER'); End; Procedure Works; Begincase Switch Of'L ': LockDrive;' U ': Unlockdrive Else Writeln ('The Switch Is Invalid!'); End; End; Procedure WriteError; BeginWriteln ('the parameter is error!'); Writeln; Help; Halt; end; procedure GetParameter; var TempStr: String [2]; TempChar: Char; beginif ParamCount> 0 thenbeginTempStr: = ParamStr (1); if TempStr [2] = ':' thenbeginTempChar: = UpCase (tempstr [1]); if TempChar in ['A' .. 'z', 'a' .. 'Z'] thendrive: = TempcharaLseWriteError; endelsewriteError; end; if paramcount> 1 Thenbegintempstr: = paramstr (2); if tempstr [1] = '/' thnbegintempchar : = Upcase (Tempstr [2]); if Tempchar in ['L', 'u'] THENSWITCH: = TempcharaLseWriteError; end; end; BeGinwriteln ('SL Version 1.0 Copyright (C) 1991 dong zhanshan'; getParameter; IF (ORD (DRIVE)> = 65) Thenif (DRIVE) - 64> GetDriveNum) The WriteError; Case paramcount OF0: Help; 1: Else WriteError; end; end; end; Program 2: Softlock.asm Turbo Pascal 4.0-6.0; Turbo Assembler Include File for SL.PAS Program; Copyright (C) 1991 Dong ZHANSHAN Title SoftlockLocals @@ DOSSEG.MODEL TPASCAL.DATAEXTRN Drive: Byte.CODEUnLockMsg1 DB 0dh, 0ah, 'Your password is correct,' DB 'the drive is unlocked!', 0dh, 0ah, '$' UnLockMsg2 DB 0dh, 0ah, 'Your password is not Correct, 'DB' The Drive Cannot BE Unlocked! ', 0DH, 0AHDB' please askWORD! 'DB 0DH, 0AH,' $ 'LockState DB' The State of the Drive Is Locked! ', 0DH, 0ah, '$' unlockstate DB 'The State of the Drive IS Unlocked!', 0DH, 0AH, '$' LockMsg DB 'this Drive Has Been Locked!', 0DH, 0AH, '$' Yourpswd DB 6 DUP (0) Pswdstr DB 'Abcdef'Pswdmsg DB' Enter The Password: $ '; Function GetDrivenum: BYTE Public GetDriveNum GetDrivenum: Push BpsUB AX, AXMOV AH, 52HINT 21HSUB AH, AHMOV Al, ES: [BX 20H] POP BPRET Procedure drivestate; Public DrivesTate Drivestate: Call Getdressmov AX, ES: [BX] CMP AX, 40HJNE @@ 1MOV DX, Offset UnlockStateCall DisplayMessengejmp @@ 2 @@ 1: MOV DX, Offset LockStateCall DisplayMessenge @@ 2: Ret Procedure LockDrive Public LockDrive LockDrive: Call Getdressmov AH, 00MOV ES: [BX], AHMOV DX, Offset LockMsgcall DisplayMessengeret Procedure unlockdrive Public UNLOCKDRIVE UnLockDrive: CALL PassWordCMP AL, 01JNE @@ 1CALL GetAddressMOV AH, 40HMOV ES: [BX], AHmov dx, offset UnLockMsg1call DisplayMessengeJMP @@ 2 @@ 1: mov dx, offset UnLockMsg2call DisplayMessenge @@ 2: Ret Get Drive Path Address; in none; out es = segment; bx = offset GetDress: Sub Ax, Axmov AH, 52HINT 21HMOV AX, ES: [BX 18h] Push Axmov AX, ES: [BX 16H] MOV BX, AxPop Essub Ch, Chmov Cl, Drivemov Al, 41HSUB CL, Alinc CL @@ 1: Add bx, 51hloop @@ 1SUB BX, 0DHRET Get a password and check it; in none; Out none; al = 0 --- invalid password; al = 1 --- valid passwordpassword: MOV DX, OFFSET PSWDMSGCALL DISPLAYMESSENGEMOV CX, 06HMOV BX, 00h @@ 1: MOV AH , 00INT 16HMOV YOURPSWD [BX], Alcall Writexcharinc BXLOOP @@ 1mov CX, 06HMOV BX, 00h @@ 2: Mov Al, YourPswd [BX] CMP Pswdstr [BX], aljne @@ 3 Inc bx loop @@ 2 MOV Al, 01HJMP @@ 4 @@ 3: MOV Al, 00 @@ 4: Ret Write a char 'x' in current cursor on screen; in none; Out None Writexchar: Push Axpush Bxpush CXMOV AH, 0AHMOV Al, 'X'MOV BH, 00MOV CX, 1INT 10HMOV AH, 03MOV BX, 00INT 10HINC DXMOV AH, 02INT 10HPOP CXPOP BXPOP AXRET Display Messenge; in dx = offset address; out none DisplayMessenge: Push DSPUSH CSPOP DSMOV AH, 09HINT 21HPOP DSRET End §3.2 Lock Hard Disk Logic Project With the update of the microprocessor, the current high-grade microcomputer is equipped with a large-capacity hard drive, which is tens of MB, and more than 100 MB. In the hard disk, you should install many public software and user files at the same time. Usually, most user files are personal private information, and they are not willing to let others view and copy. The journal introduces the encryption method of multiple hard drives, mostly the entire hard disk, prohibiting users who do not know the password. Through the detailed analysis of the hard disk logic disk structure, I propose an effective way to encrypt a logical disk of the hard disk, reaching the purpose of exclusively, a hard disk logic disk, which solves the above problems. 3.2.1 Internal structure of the logical disk FDisk The main guidance of the hard disk is stored in the first physical sector in the hard disk, namely 0 surface 0 column 1 sector, at the 1beh-1FDH of the sector (64 bytes) is a partition table of the hard disk, we call This partition table is the main partition table, which consists of 4 16-byte registration items, and each registry describes a specific partition, where the meaning of each byte represents Table 3-2. Table 3-2. The meaning of each byte partition table entry Jue ┌──┬──┬───────┬──┬───────┬───┬───┐│ │ Launch │ Partition Start │ System │ Partition End │ Relative Fan │ Sector ││ │ Sign │ Head Distance Cylinder │ Sign │ Head Distance Cylinder │ Area │ Total │├───────── ───────────────────────────────── ─ │ │ │01 02 03 │ 04 │05 06 07 │08-11 │12-15 │ └ - ┴─┴───────────────────────────────────────────────────────────tes : DOS partition, the partition FAT table is 12 digits; 02: Xenix partition; 04: DOS partition, the partition FAT table is 16 bits; 05: Extend DOS partition; 06: large DOS partition, for MS DOS 4.00 The above DOS version is managed by the flag used in the management greater than 32MB or logical partition, and the partitioned FAT table is 16 bits per item. The FDISK program of the MS / PC DOS 3.30 puts the initial DOS partition information in the first registration entry of the primary partition table, and the second registration is expanded to DOS partition information, and the rest of the registration item is empty. The initial DOS partition represents the C logic disk, and the division of the DOS partition is divided into its own partition table. The division information of the extended DOS partition is recorded on the first sector of the extended DOS partition. This partition is called the first expansion DOS partition table, where the first registration item records the information of the D logic disk, the second The registry records the second extension DOS partition information; the first sector of the second extension DOS partition records information of the expansion DOS partition, the first registration item records the information of the E logic disk, the second The registry records the third extension of the DOS partition; in this type, you can find all the information of all expansion partitions. Table 3-3 lists all partition information for a 62MB hard disk. From Table 3-3, you can know that fdisk puts the partition information of the hard disk on a different physical sector of the hard disk in a linked list format, and each logical disk has a corresponding partition information table, and corresponds to one by one physics sector. For example, the C disk corresponds to the 0 surface 0 column 1 sector, the D disk corresponds to the 0 surface 90 column 1 sector. Table 3-3. A 62MB hard drive partition information table 殌 ┌ ┌ ┌ - ─ ─ ─ ─ ┬─────────────────────────────── ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ │ System │ Launch │ Partition Start │ Partition End │ Relative │ Total Fan │ Logic │ │ Face Corps │ Sign │ Sign │ Face Corpand │ Famous Fan │ Sector │ Area │ │├─────────────────────── ─ ┼─┼──────────────────────────────── ─ ┤│0 0 1 │DOS-12│YES │1 0 1 │7 89 26│26│ 18694│C ││ │ t │1613 26│ 18720│108992│ │├── ┼───────────────────────────────────── ┼─────── ─ ─ ┤│0 90 1│DOS-16│NO │1 90 1 │7 289 26│26│ 41574│D ││ │ etd│NO │0 290 1 │7 389 26│ 41600│D 20800│ │├ - ─ ───────────────────────────────────────────────── ─ │ 0 290 1│DOS-16│NO │ 1 290 1 │7 389 26│ 26│20774│E ││ │ et │NO │0 390 1 │7 613 26│62400│46592│ │├─────────────────────────────────────── ┼────────────────────── ┤│0 390 1│DOS-16│NO │1 390 1 │7 613 26│26│ 46566│F │ └─── ┴ ─ ┴────────────────────────────────────── ┘ 殣 殣3.2.2 Hard disk data confidential principle DOS pair management of logical disk is through a single The chain links several independent continuous panels, each continuous panel has a complete partition boot record, FAT, file objectives, and data area. DOS During the startup process, the logical partition is identified according to the content of the system flag bytes of each registered item in each partition. If the value of the byte is a valid value of the DOS partition, DOS is considered a valid partition. After the system is activated, the user uses this partition through a logical disk; otherwise it is considered an invalid partition. After the system is started, the logical pair of logical panels is not available, and the user cannot use this partition. The data is temporarily "implied". . According to the above principles, we can use the 13H number provided by the BIOS to complete the read / write and system flag bytes of the hard disk partition table, and implement the lock and unlock of the logical partition, reach the security and confidentiality of personal data and confidential data. § 3.2.3 Programming and Its Use The basic idea of programming is: first read the partitioned table chain into memory, analyze the status of each partition, according to the user's requirements, if you lock a partition, it is determined that the current state of the partition, if it is locked, then return, otherwise For the system flag byte of the registration item representative of the partition, prompt the user input password, and finally write the modified partition table back to the corresponding physical sector, after restarting the machine, the partition "disappears"; unlock The process is basically the same, but there are more processes of a checking password. I use Turbo Pascal to write a program HDL.PAS. After compiling the execution file, run directly under the DOS system, it can easily complete the lock and unlock of the hard disk logical partition, and can add the user's own password, a logic After the disc is locked, the user who does not know the password cannot be opened. The method of use is simple, which is used in the format: HDL, where D is the logical partition corresponding to the logical partition, such as C, D, etc., Switch is the selection switch, can be selected: L - is a lock logie partition; u - to unlock Logical partition; angle representative parameters can be default. For example, execute help information for "HDL" display; execute "HDL D:" to display the current state of the D logical disk; execute "HDL D: / L" lock D logical disk. ---------------------------------------------- you are a wind I am a sand, the forum is my home ps: "Sands" is my old id, "Shuimu Sand": = "Sands" newly registered a ID - Passbyword, or me. 2003-4-2 16:00:46 Sands Title: Website Level: Administrator Prestige: 2 Articles: 927 Points: 1863 School: Anti-Japan Union Registration: 2002-8-4 §3.2.4 Source Procedure List {HDL.PAS 1.1} {CopyRight (C) 1992, 94 dong zhanshan} Program hard_disk_lock; {This Program MAY LOCK or Unlock A Logical Partition} {of the hard disk. It was write by diTwings} {1992.8 at cri. Uses Disk; Var {store all partition information} buffer: array [1..24] of mbrt; {store stats: array [1..24] of boolean; {the number of logical drives} drivenum: byte DRIVENUM: BYTE DRIVEN Switch, Drive: char; Procedure reboot; Inline ($ EA / $ 00 / $ 00 / $ FF / $ FF); {JMP ffff: 0000} Function Readkey: Char; Inline ($ B4 / $ 07 / {MOV AH, 07} $ CD / $ 21); {INT 21H} Procedure help; {the help information of this program} beginwriteln ('syntax: hdl [d:] [/ switch]'); Writeln ('Switch: l = lock the specifed drive "); Writeln (' u = unlock the specifed Drive '); Writeln (' Examples: HDL - Display Help Text '); Writeln (' HDL D: - Display The State of Drive D: '); Writeln (' HDL D: / L - Lock The Drive D) : '); Writeln (' HDL D: / U - UNLOCK The Drive D: '); Function FindExtendedPartition (p1: mbrt): Byte; {Find The position of extended dos partition} var i: Byte; beginfindextendedPartition: = 0; for i: = 1 to 4 dobeginif (p1.partitionTable [i] .sysindicator = 5) OR (not p1.partitionTable [i] .sysindicator = 5). = i; eXit; Function FindDospartition (P1: Mbrt): Byte; {Find the position; beginfinddDospartition: = 0; for i: = 1 to 4 dobeginif (p1.partitionTable [i] .sysindicator in [1, 4, 6]) or (not p1.PartitionTable [i] .sysindicator in [1,4,6]) THENBEGINFINDDOSPARTITION: = I; EXIT; End; end; end; procedure writeerror (s: string); beginwriteln (s); halt ; Function Readpassword: String; Var Ch: Char; TSTR: STRING [6]; DONE: BOOLEAN; i: BYTE; begindone: = false;: = 0; tstr: = '; repeat: = readkey; Case ch y # 0: CH: = readkey; # 13: done: = true; # 27: begindone: = true; tstr: = '; end; else begininc (i); tstr: = TSTR CH; Write (' x ') ; if i = 6 DONE: = true; end; end; until done; readpassword: = TSTR; END; Procedure setPassword (var p1: mbrt); var tstr1, tstr2: string [6]; i: byte; beginfor i: = 0 to 6 dobegintStr1 [i]: = # 0; TSTR2 [i]: = # 0; repeatwrite ( 'Please enter password:'); tstr1: = readPassWord; writeln; write ( 'Please enter password again:'); tstr2: = readPassWord; writeln; until tstr1 = tstr2; move (tstr1 [0], p1.MainBoot [439], 7); Function getPassword (p1: mbrt): boolean; var tstr1, tstr2: string [6]; i: byte; begingetPassword: = false; for i: = 0 to 6 dobegintStr1 [i]: = # 0; tstr2 [i]: = # 0; End; Write ('please enter password:'); TSTR1: = Readpassword; Writeln; Move (P1.mainboot [439], TSTR2 [0], 7); if Tstr1 = TStr2 Then getPassword: = true; END; Procedure lockdrive; var startcyl, startsec: byte; i, j: byte; p: mbrt; begini: = ord (drive) - ORD ('c') 1; if drivestate [i] thenbeginif i = 1 ThenbeginStartcyl: = 0 Startsec: = 1; endelsebeginj: = FINDEXTENDEDPARTINE (Buffer [i-1]); startcyl: = buffer [i-1] .PartitionTable [J] .startcylinder; startsec: = buffer [i-1] .PartitionTable [j] .Startsector; end; j: = findd.com; buffer [i] .PartitionTable [j] .sysindicator: = not buffer [i] .PartitionTable [j] .sysindicator; setPassword (buffer [i]); P: = Buffer [I]; Processphysicalsector (3, $ 80, 0, Startcyl, Startsec, 1, P); Writeln ('The Drive', Drive, ': HAS BEEN LOCKED!'); Reboot; endelsewriteln ('The Drive ', Drive,': End; Procedure UnlockDrive; Var Startcyl, StartSec: Byte; I, J: Byte; P: Mbrt; Begini: = ORD (Drive) - ORD ('c') 1 If not drivestate [i] thenbeginif getpassword (buffer [i]) THENBEGINIF I = 1 ThenbeginStartcyl: = 0; startsec: = 1; endelsebeginj: = FINDEXTENDEDPARTITION (Buffer [i-1]); startcyl: = buffer [I-1 ] .PartitionTable [J] .startcylinder; StartSec : = Buffer [i-1] .PartitionTable [J] .startsector; end; j: = finddospartition (buffer [i]); buffer [i] .partitionTable [j] .sysindicator: = not buffer [i] .PartitionTable [ J.Sysindicator; P: = Buffer [I]; Processphysicalsector (3, $ 80, 0, Startcyl, Startsec, 1, P); Writeln ('The Drive', Drive, ': HAS BEEN UNLOCKED!'); Reboot; EndelsewriteError ('Your Password Is Error, The Drive' Drive '); endelsewriteln (' The Drive ", ': is unlocked!'); Procedure Works; Begincase Switch Of'L ': LockDrive;' U ': UNLOCKDRIVE; End; Procedure getDriveState; var i: byte; begini: = ord (drive) - ORD ('c') 1; if drivestate [i] thenwriteln ('the drive ",': is unlocked! ') Elsewriteln (' THE Drive ', drive,': is locate! '); End; procedure getParameter; var tempstr: string [2]; tempchar: char; beginif paramcount> 0 thenbegintempstr: = paramstr (1); if Tempstr [2] =': 'thenbeginTempChar: = UpCase (tempstr [1]); if TempChar in [' A '..' Z '] thenDrive: = TempCharelseWriteError ('! Does not exist this drive '); endelseWriteError (' The first parameter is error '! ); End; if paramcount> 1 Thenbegintempstr: = paramstr (2); if Tempstr [1] = '/' THENBEGINTEMPCHAR: = Upcase (TempStr [2]); if Tempchar In ['L', 'u'] Thenswitch: = TempCharaLseWriteError ('The Switch Is Error!'); EndelsewriteError ('the second parameter is error!'); End; Procedure getAllPartition; var startcyl, startsec: word; i, j, k: byte; p: mbrt; beginstartcyl: = 0; startsec: = 1; i: = 0; RepeatProcessphysicalsector (2, $ 80, 0, Startcyl, Startsec, 1 , p); J: = FINDEXTENDEDPARTITION (P); startcyl: = p.PartitionTable [j] .startcylinder; startsec: = p.PartitionTable [J] .startsector; INC (i); buffer [i]: = p; k : = FindDospartition (P); IF (p.PartitionTable [1, 4, 6]) THEN DRIVESTATE [I]: = true; until j = 0; drivenum: = i; Procedure init; begindrive: = # 0; for i: = 1 to 24 do drivestate [i]: = false; BeGinwriteln ('HDL Version 1.0, Copyright (C) 1992 dong zhanshan'); init; getParameter; getAllPartition; if Drive <> # 0 THENIF (Drive In ['a', 'b']) ThenwriteError ('FloppPy Diskette is Not Able to be locked! ') Else if (DRIVE)> = 67) THENIF (DRIVE) - 66> Drivenum) ThenwriteError (' this Logical Drive Does Not Exist!); Case paramcount OF0: Help; 1: GetDriveState; 2: Works; Else WriteError ('Too Many Parameters!'); End; end.§3.3 Draft paper typography printing program The draft paper typography print program (SP) is a universal manuscript print program, written in Turbo Pascal, running under Chinese, English operating system. SP is suitable for the Chinese documentation, the manuscript of Chinese, English, chart, is clearly clear and beautiful, the author of the scientific articles, the authors of literary works, and other writing enthusiasts, SP will be an unparalleled good helper. SP can save your own troubles, so that you will free from heavy duplicate labor and go to the more meaningful job. The editorial department of the magazine newspaper requires the author of the article, writing the manuscript to the checkered paper, in order to send the trial and typography, avoid unnecessary errors, this will increase the author of the article. People who write articles will write articles to "crawage", very image, symbolizing the hard work of writing articles, I am also a "crawling", bitter thinking, how can I change "crawling" into one What is the truth of enjoyment? We have already across the era of office automation, and many things you have made by people are now done by the computer. In line with the trend of the times, keep up with the era, give the "crawling" problem to the computer. After the manuscript is written, enter the computer and then use the VCP print program. §3.3.1 Principles required for programming Technological articles are generally mixed in Chinese and English, and insert some charts, the general principles of Fang Gend's draft paper are habit, standardized, and simple. First, the chart is required to be treated separately. The chart is used as a whole direct output. The text section requires Chinese, and the English is treated separately, the Chinese characters, the English continuously; secondly, the title of the article is a medium version, the beginning of the paragraph Leave two spaces; three, to correctly page and encode; its fourth, to meet certain special requirements; don't take into account, most people are editing text with WS or WPS, including the text Many typography, these characters are not normal visible ASCII characters, so the program is pre-processed, and then the typeset output. The program uses the command string format and provides several selection switches, which are specified by the user, making the program more flexible and convenient. §3.3.2 Main features of the program This program adopts the code excellent technology, the code is compact, and the execution is fast. According to the principle of design, the difficult point is mainly in Chinese and English separation and classification processing, the output of the chart. The main features of the program have three:. Complete the conversion of the WS or WPS text file to the pure ASCII text file. Complete the plain version of the checkered paper paper of the pure ASCII file. Display output typography results, print output typography §3.3.3 How to use Syntax: SP (1) Command format: 1CTRL code 2Ctrl code number # 5 where 'ctrl code' has four options: ^ c, ^ O, ^ S, ^ T, 'number' can be any integer between 1-999, '# 'The end of the command. (2) Command Category: 1 Command: ^ C2 section Edition command: ^ SN # where N is arbitrary integer between 0-20, represents the number of spaces left before the paragraph. 3 row-like print command: ^ On # where N is the original print line, between 1-999. 4 Chart Typographic command: ^ TN # where n is the number of charts, between 1-999. 5. Strike (1) WS file (all-run command) is as follows: ^ C Fragus Printing software SP V2.0 Chinese Academy of Agricultural Sciences Cotton Research Directors ^ S2 # SP V2.0 Software File List: ^ O7 # SP .DOC SP User Manual, this file sp.PAS SP PASCAL source SP.EXE SP executor demo1.txt A demo file Demo2.txt is another demo file Demo1.bat demo1.txt batch file Demo2.bat Demo2.txt Batch File ^ S2 # SP V2.0 main function and its selection switch is shown in Table 1. ^ T10 # Table 1. The main functions of SP V2.0 and their choice switches - ──────────────────── ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ ─ │ ├─────────────────────────── ─ ─ │ / D: Showing Translation Results Text ││ 2 Translation Text │ / E: Delete Translation Output File ││Fable File │ / P: Print Translation Site ││ 3 Print Output Draft Document │ / T: When entering the file is WS file, ││ │ convert the WS file is an ASCII code file │ └ --───────────────────── §3.3.5 Source Procedure List {Sp.pas 2.0} {CopyRight (c) 1991 dong zhenshan} {$ M 16000, $ 0,16000} Program sp; {Cheese manuscript printing program V2.0} Uses CRT, DOS; TypeCtrltype = Record {Define typography command type} fmt: char; count: integer; end; constwps_1 = # $ 91 # $ 81 # $ 92 # $ 94 # $ 9b # $ 90 # $ 99 # $ c1; {WPS typography command} WPS_2 = # $ 91 # $ 80 # $ 92 # $ 85 # $ 9b # $ 80 # $ 99 # $ c0; {WPS typography command} crch = # $ 0d; {Defining Enter} chitabchar: array [1..5, 1..2] of string [ 2] = ({Definition Chinese Table] ('┌', {Left Upper Corner} '┐'), {Right Upper Corner} ('└', {Left Down Corner} '┘'), {Right Down Corner} ('─', {colorn} '│'), {row} ('┬', {UPPER T} '┴'), {DOWN T} ('├', {Left T} '┤') {Right T }); Constctrl: ctrltype = (fmt: ^ s; {Define typography command constant} count: 2); display: boolean = false; {display control constant} print: boolean = false; {print control constant} ERASE: boolean = False; {Delete Control constant} Trans: boolean = false; {conversion control constant} Copyright = 'MF SP Version 2.0 CopyRight (C) 1990, 1991 MF Software Company'; Var TempStr1, TempStr2, ESTR, CSTR, {Working String Variable} Registerch, PS1, PS2: String; {Registration String} f1: file; {input file} f2: text; {output file} CR, Start, Chinese, English: boolean; {Boolean variable} ch: char; {Character variable} fmtcom: ctrltype; {control command variable} Pagenum, LINENUM, {page number, number of rows} Curfilelen, Len, Result: Word; {Current File Location} TextLine, UPLINE, DOWNLINE: STRING; {Generated Text Row} Procedure initstr; {initialization variable} begintextLine: = chitabchar [3, 2]; Download: = chitabchar [5,1]; upline: = chitabchar [5,1]; tempstr1: = '; tempstr2: ='; estr : = '; Cstr: ='; registerch: = '; PAGENUM: = 0; LINENUM: = 0; curfilelen: = 0; Chinese: = false; English: = false; start: = true; fmtcom: = Constctrl; end; Procedure anstr1 (s1: string; varing; var len: word); {Find the car in S1, and give S2} var i: integer; begini: = POS (CRCH, S1 ); if i = 0 THEN i: = POS (# $ 1a, s1); if i <> 0 damEginCr: = true; move (S1, S2, I-1); S2 [0]: = CHR (i - 1); LEN: = i 1; endelsebegincr: = false; s2: = S1; len: = ORD (S1 [0]); end; end; procedure del, (var); {Delete string s Pre-guide space} Beginif Start thenwhile (s [1] = '') AND (ORD (S [0])> 1) DOBEGINMOVE (S [2], S [1], ORD (S [0]) - 1) ; s [0]: = CHR (ORD (S [0]) - 1); End; IF (S [1] = '') AND (ORD (S [0]) = 1) THEN S [0]: = CHR (0); end; Procedure getchar (var ch: string; var ch: char); {Take a character CH from S and remove the CH from s} Beginch: = S [1]; Move (s [2], s [1] , ORD (S [0]) - 1); s [0]: = CHR (ORD (S [0]) - 1); Procedure proctrlchar; {取 排 版} process; {{{TS: String [3]; C, I: Integer; Begini: = 0; ts: = '; recomatner (TempStr2, CH) If Ch <> # 'THEN TS: = TS CH; INC (i); Until (CH =' # '); VAL (TS, FMTCOM.COUNT, C); END; Begincase ch y ^ c: fmtcom.fmt: = ^ c; ^ o, ^ s, ^ t: beginfmtcom.fmt: = ch; seekcount; end; else fmtcom: = constctrl; end; start: = true; Procedure printpagetail; {Outgo page tail} var i: integer; beginwrite (f2, chitabcharal [2,1]); for i: = 1 to 39 do Write (f2, chitabcharal [3, 1]); Writeln (F2, Chitabchar [2, 2]); Writeln (F2, '20X20 = 400 first', PAGENUM, 'page'); {for i: = 1 to 18 DO WRITELN (F2);} LINENUM: = 0; Procedure printpagehead; {output page} var i: integer; beginwriteln (F2, WPS_1 '"); Write (F2, WPS_2); Write (f2, chitabcharal [1, 1]); for i: = 1 to 39 do Write (f2, chitabchar [3, 1]); Writeln (F2, Chitabchar [1, 2]); Procedure writeline; {Output text line} BeginWriteln (F2, UPLINE); WRITELN (F2, TextLine); Writeln (F2, Downline); UPLINE: = chitabchar [5,1]; textline: = chitabchar [3, 2]; DOWNLINE : = Chitabchar [5,1]; inc (LINENUM); if Linenum = 20 damEgininc (PAGENUM); PrintPageTail; PrintPageTail; End; End; Procedure Writespaceline (x: integer; done: boolean); {Output X line DRO, DONE is true when it also outputs the page tail} var i: integer; beginfor i: = 1 to 19 dobeginupline: = UPLINE chitabchar [3,1] chitabchar [4,1]; downline: = DOWNLINE chitabchar [3, 1] Chitabchar [4, 2]; TextLine: = TextLine '' chitabchar [3,2]; end; upline: = upline chitabchar [3,1] chitabchar [5,2]; downline: = DOWNLINE chitabchar [3, 1 ] Chitabchar [5, 2]; TextLine: = TextLine '' chitabchar [3,2]; for i: = 1 to x dobeginwriteln (F2, UPLINE); Writeln (F2, TextLine); Writeln (F2, Downline) , INC (LINENUM); END; IF DONE THENBEGININC (PAGENUM); PRINTPAGETAIL; endelsebeginupline: = chitabchar [5,1]; textline: = chitabchar [3, 2]; Download: = chitabchar [5,1]; end; end; ; Procedure proccstr; {processing Chinese string} begincase ord (TextLine [0]) OF0..76: BeginTextLine: = TextLine CSTR [1] CSTR [2] chitabchar [3, 2]; UPLINE: = UPLINE Chitabchar [3 , 1] chitabchar [4, 1]; Download: = DOWNLINE Chitabchabchar [3,1] chitabchar [4, 2]; if ORD (CSTR [0])> = 4 Thenbeginmove (CSTR [3], CSTR [1 ], ORD (CSTR [0]) - 2); CSTR [0]: = CHR (ORD (CSTR [0]) - 2); proccstr; endelse if ORD (CSTR [0]) = 3 ThenRegisterch: = CSTR [ 3]; END; 78..82: begintextline: = TextLine CSTR [1] CSTR [2] chitabchar [3, 2]; UPLINE: = UPLINE Chitabchar [3,1] chitabchar [5,2]; downline : = Download Chitabchar [3,1] Chitabchar [5,2]; WriteLine; if ORD (CSTR [0])> = 4 Thenbeginmove (CSTR [3], CSTR [1], ORD (CSTR [0]) - 2); CSTR [0]: = CHR (ORD (CSTR [0]) - 2); proccstr; endelse if ORD (CSTR [0]) = 3 ThenRegisterch: = CSTR [3]; End; end; Chinese: = False; cstr: = ''; end; -------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------- ------ You are a wind, I am a sand, the forum is my home. PS: "Sands" is my old ID, "water-wood sand": = "Snow people" newly registered a ID - Passbyword, or me. 2003-4-2 16:01:11 Windsha people title: Webmaster level: administrator Prestige: 2 Articles: 927 Points: 1863 School: Anti-Japan Union Registration: 2002-8-4 Procedure procestr; {Treat English string} procedure addupline (x1, x2: integer); var i: integer; beginfor i: = 1 to x1 * 2 doupline: = UPLINE chitabchar [3,1]; case x2 of1: begincase ORD (UPLINE [0]) OF0..76: UPLINE: = UPLINE Chitabchar [3,1] chitabchar [4,1]; 78..82: Upline: = UPLINE Chitabchar [3, 1] chitabchar [5, 2]; End; End; 2: Begincase ORD (UPLINE [0]) OF0..76: UPLINE: = UPLINE Chitabchar [3,1] chitabchar [3,1]; 78..82: UPLINE: = UPLINE Chitabchar [3, 1] chitabchar [5, 2]; end; end; end; end; procedure adddownload; var i: integer; beginfor i: = 1 to x1 * 2 DODOWNLINE: = DOWNLINE Chitabchar [3,1]; case x2 of1: begincase ord (Downline [0]) OF0..76: Download: = Download Chitabchar [3,1] chitabchar [4, 2]; 78..82: Download: = Download Chitabchar [3,1] Chitabchar [5,2]; end; end; 2: begincase ord (downline [0]) OF0..76: Download: = Download chitabchar [3,1] chitabchar [3, 1 ]; 78..82: Download: = DOWNLINE chitabchar [3,1] chitabchar [5, 2]; end; end; end; Procedure procestr1; var i, x: integer; begini: = ORD (estr [0]); if i mod 4 = 0 THEN x: = 4 else x: = i mod 4; case x of1: beginaddupline (I Div 4, 1); AdddownLine (I Div 4, 1); TextLine: = TextLine ESTR '' Chitabchar [3,2]; End; 2: Beginaddupline (I Div 4, 1); AdddownLine (I Div 4, 1) TextLine: = TEXTLINE ESTLINE ESTR CHITABCHAR [3, 2]; END; 3: Beginaddupline (I Div 4, 2); AdddownLine (I Div 4, 2); TextLine: = TEXTLINE ESTR '; END; 4 : Beginaddupline (I Div 4 - 1, 2); AdddownLine (I Div 4 - 1, 2); TextLine: = TEXTLINE ESTR; End; End; End; Beginif Ord (ESTR [0])> 80 - ORD (TextLine [0]) THENBEGINTEMPSTR1: = COPY (estr, 80 - ORD (TextLine [0]) 1, ORD (ESTR [0]) - (80 - ORD (TextLine [0])); delete (estr, 80 - ORD (TextLine [0]) 1, ORD (ESTR [0]) - (80 - ORD (TextLine [0]))); Procestr1; WriteLine; ESTR: = TempStr1; Procestr1; EndelseProcestr1; if Oord (TextLine [0 ]) = 82 THEN WRITELINE; ENGLISH: = false; estr: = '; end; procedure procstr2; {processing string} beginrepeatgetchar (TempStr2, ch); Case Chs # $ 20 .. # $ 7f: Beginif Chinese Then Proccstr中文: = True; estr: = estr ch; if ORD (ESTR [0])> = 40 Then Procestr; end; # $ 80 .. # $ ff: beginif english damtr; Chinese: = true; cstr: = CSTR CH; IF ORD (CSTR [0])> = 20 THEN PROCCSTR; END; END; Until TempStr2 = '; if Chinese Then Proccstr; if English thenbeginif cr dam: = estr; estr: ='; End; end; END; Procedure readstr; {read characters from the file into a string, then generate tempstr2} begin {$ I-} blockRead (F1, TempStr1, 250, Result); {$ I } Move (TempStr1 [0], TempStr2 [1] , TempStr2 [0]: = chr (Result); TempStr1: = TempStr2; Anstr1 (TempStr1, TempStr2, Len); Inc (Curfilelen, LEN); SEEK (F1, Curfilelen); End; Procedure STRSEGMENTPROC; {Segment Treatment} VAR I, X, C: Integer; Procedure CompleteLine; Var i: Integer; BeginFor i: = 1 to (78 - ORD (TextLine [0])) Div 4 dobegintextLine: = TextLine '' chitabchar [3, 2]; UPLINE: = UPLINE Chitabchabchar [3,1] chitabchar [4,1]; downline: = DOWNLINE chitabchar [3,1] chitabchar [4, 2]; end; textline: = textline '' chitabchar [ 3, 2]; UPLINE: = UPLINE Chitabchar [3,1] chitabchar [5,2]; downline: = DOWNLINE Chitabchar [3,1] chitabchar [5,2]; writeline; start: = true; cr: = false; registerch: = '; END; beginTempStr2: = ch Tempstr2; DelSpace (Tempstr2); if start thenbeginif FMTCom.Count = 0 then ProcStr2elsebeginfor i: = 1 to FMTCom.Count dobeginTextLine: = TextLine '' ChiTabChar [3,2]; Upline: = Upline ChiTabChar [ 3, 1] chitabchar [4,1]; downline: = DOWNLINE chitabchabchar [3,1] chitabchar [4,2]; end; procStr2; end; start: = false; endelseprocstr2; if cr dam, = false; ie1; [0]) <> 2) THEN COMPLETELSEEELSEBEGINSTART: = true; cr: = false; registerch: = '; end; end; Procedure strCenterProc; {中 排 处理 处理} Procedure LeavemagSpace; Var i, J, K: Integer; TSTR1, TSTR2, TSTR3: String; Begini: = 80 - ORD (TextLine [0]); J: = I Div 4; TSTR1: = Chitabchar [5,1]; tstr2: = chitabchar [3,2]; tstr3: = chitabchar [5,1]; fork: = 1 to j div 2 dobegintstr1: = TSTR1 chitabchar [3,1] chitabchar [4, 1]; TSTR2: = TSTR2 '' chitabchar [3,2]; tstr3: = TSTR3 chitabchar [3,1] chitabchar [4, 2]; end; UPLINE: = TSTR1 UPLINE; TextLine : = TSTR2 TEXTLINE; DOWNLINE: = TSTR3 DOWNLINE; if i mod 4 <> 0 THEN J: = J 1; IF J MOD 2 <> 0 THEN J: = J Div 2 1ELSE J: = J DIV 2 For K: = 1 To J - 1 Dobeginupline: = UPLINE Chitabcha [3,1] chitabchar [4,1]; textline: = textline '' chitabchar [3, 2]; Download: = Download chitabchar [3, 1] chitabchar [4, 2]; end; upline: = UPLINE chitabchar [3,1] chitabchar [5,2]; textline: = textLine '' chitabchar [3, 2]; Download: = DOWNLINE Chitabchar [ 3, 1] chitabcharal [5, 2]; end; begintextline: = ''; UPLINE: = '; DOWNLINE: ='; tempStr2: = CH TEMPSTR2; DELSPACE (TempStr2); procs Tr2; Leavemagspace; WriteLine; Procedure StrOrigProc; {layout processing is outputted} typeOrigStrPtr = ^ OrigStrType; OrigStrType = array [1..60] of string; varOrigStr: OrigStrPtr; x, y, z, oldLineNum: integer; Procedure MakeProc (x1, x2: integer); Var i, j: integer; begingetMem (Origstr, x2 * 246); Origstr ^ [1]: = chitabchar [5,1]; for i: = 1 to 39 doorigstr ^ [1]: = OrigStr ^ [1] Chitabchar [3, 1]; Origstr ^ [1]: = Origstr ^ [1] chitabchar [5, 2]; for i: = 2 to x2 * 3 - 1 dobeginorigstr ^ [i]: = chitabchar [3, 2 ]; for j: = 1 to 39 doorigstr ^ [i]: = Origstr ^ [i] ''; OrigStr ^ [i]: = OrigStr ^ [i] chitabchar [3, 2]; end; if ing odd ( X2) Then Origstr ^ [x2 * 3]: = Origstr ^ [1] else Origstr ^ [x2 * 3]: = OrigStr ^ [2]; Move (TempStr2 [1], OrigStr ^ [2] [3], ORD (TempStr2 [0])); if x1> 1 thenbeginfor i: = 2 to x1 dobeginreadstr; Move (TempStr2 [1], OrigStr ^ [i * 2] [3], ORD (TempStr2 [0])); End; for i: = 1 to x2 dobeginupline: = Origstr ^ [(i-1) * 3 1]; TextLine: = OrigStr ^ [(i-1) * 3 2]; Download: = Origstr ^ [( I-1) * 3 3]; WriteLine; End; FreeMem (Origstr, x2 * 246); TempStr2: = '; end; procedure procmanline; becom INREADSTR; IF XX> 30 THENBEGINMAKEPROC (30, 20); Procmanline (xx - 30); endelseif xx * 2 mod 3 <> 0 Then MakeProc (xx, xx * 2 Div 3 1) Else makeproc (xx, xx * 2 DIV 3); BegintempStr2: = CH TempStr2; x: = fmtcom.count; y: = x * 2; if y mod 3 <> 0 THEN Z: = Y DIV 3 1ELSE Z: = Y DIV 3; if z <= 20 - LINENUM THEN MakeProc (X, Z) ElsebeginoldLinenum: = LINENUM; MakeProc ((20 - LINENUM) * 3) DIV 2, 20 - LINENUM); Procmanline (X - (20 - OldLinenum) * 3 Div 2); end; end; ; Procedure StrTableProc; {graphical output layout processing} typeOrigStrPtr = ^ OrigStrType; OrigStrType = array [1..60] of string; varOrigStr: OrigStrPtr; x, y, z, OldLineNum: integer; Procedure MakeProc (x1, x2: integer); Var i, j: integer; begingetMem (Origstr, x2 * 246); Origstr ^ [1]: = chitabchar [5,1]; for i: = 1 to 39 doorigstr ^ [1]: = OrigStr ^ [1] Chitabchar [3,1]; Origstr ^ [1]: = Origstr ^ [1] chitabchar [5, 2]; for i: = 2 to x2 * 3 dobeginorigstr ^ [i]: = chitabchar [3, 2]; For J: = 1 to 39 Doorigstr ^ [i]: = OrigStr ^ [i] ''; OrigStr ^ [i]: = OrigStr ^ [i] chitabchar [3, 2]; end; move (TempStr2 [1 ], Origstr ^ [2] [3], ORD (TempStr2 [0])); if x1> 1 thenbeginfor i: = 2 to x1 dobeginreadstr; Move (TempStr2 [1], OrigStr ^ [i 1] [3] , ORD (TempStr2 [0]))); end; end; for i: = 1 to x2 dobeginupline: = Origstr ^ [(i-1) * 3 1]; TextLine: = OrigStr ^ [(i-1) * 3 2]; Downline: = Origstr ^ [(i-1) * 3 3]; WriteLine; End; FreeMem (Origstr, x2 * 246); TempStr2: = '; end; procedure procmanline (xx: integer) BeginReadStr; if xx> 59 thenbeginmakeproc (59, 20); xx: = xx - 59; procmanline (xx); endel SEIF (XX 1) MOD 3 <> 0 Then MakeProc (XX, (XX 1) DIV 3 1) Else makeproc (xx, (xx 1) DIV 3); BegintempStr2: = CH TempStr2; x: = fmtcom.count; y: = x 1; if y mod 3 <> 0 THEN Z: = Y DIV 3 1ELSE Z: = Y DIV 3; if Z <= 20 - LINENUM THEN MakeProc (x, z) elsebeginoldLinenum: = lineenum; makeproc ((20 - linenum) * 3 - 1, 20 - linenum); procmanline (x - (20 - oldlinenum) * 3 1); END; Procedure anstr2; {Analysis TempStr2} BeginRepeatgetChar (TempStr2, CH); Case Chs ^ c, ^ o, ^ s, ^ T: proctrlchar; # $ 20 .. # $ ff: Case Fmtcom.fmt of ^ c: strCenterProc; ^ O: StrorigProc; ^ s: strsEgmentProc; ^ T: startProc; end; end; until tempstr2 = ''; end; procedure ws_ascii (fn1: string); {conversion WS file is ASCII file} var f1: file; f2: text Beginassign (F1, Fn1); Assign (F2, '$$$. $$$); Reset (F1, 1); Rest (F2); RepeatBlockRead (F1, CH, 1); Case CH of # $ 8d : BeginblockRead (F1, CH, 1); Blockread (F1, CH, 1); end; # $ 0d: BeginblockRead (F1, CH, 1); Case Chs # $ 8a: BeginWrite (F2, # $ 0d # $ 0A Blockread (F1, CH, 1); end; # $ 0a: write (f2, # $ 0d); end; end; end; write (f2, ch); until eof (f1); Close (F1); Close (F2); END; Procedure help; {Help Process} BeginWriteln ('Syntax: SP []'); Writeln ('Options: / D = Display Theput File'); Writeln ('/ E = Erase the Output File'); WriteLn ('/ P = print the output file '; WriteLn (' / t = translate the input file with ws_ascii '); Halt; end; Function YESNO (S: String): boolean; {answer yes or no} beginyesno: = false; Write (s, '? (y / n)'); ch: = readkey; Writeln (CH); if Chin [' Y ',' Y '].................... Function exist (filename: string): boolean; {Judgment file exists} var f1: text; i: integer; beginassign (f1, filename); {$ I-} reset (f1); {$ i } i: = ioresis ; if i = 0 THEN EXIST: = TrueElse EXIST: = FALSE; Procedure parseComline; {Command line analyzer} var i: integer; procedure proccomlinestr (s: string); var i: integer; beginfor i: = 1 to ORD (s [0]) DOS [I]: = Upcase (s [ I]); if s = '/ d' Then Display: = true; if s = '/ e' Then ERASE: = true; if s = '/ p' Then Print: = true; if s = '/ t' .. Begini: = paramcount; IF i = 2 THEN EXIT; Case I of3: Proccomlinestr (paramstr (3)); 4: BeginProccomlinestr (paramstr (3)); Proccomlinestr (paramstr (4)); end ; 5: beginProcComlineStr (paramstr (3)); ProcComlineStr (paramstr (4)); ProcComlineStr (paramstr (5)); end; 6: beginProcComlineStr (paramstr (3)); ProcComlineStr (paramstr (4)); ProcComlineStr (paramstr (5)); Proccomlinestr (paramstr (6)); end; end; end; procedure translateText (fn1, fn2: string); {translation ASCII file is a checkered paper text file} Beginassign (F1, Fn1); Reset (F1) , 1); Assign (F2, Fn2); Rewrite (F2); INITSTR; PrintPagehead; Repeat {Main cyclic body} ReadStr; TempStr2: = registerch TempStr2; Registerch: = '; DELSTR2 <> '' 'TEN ANSTR2; Until EOF (F1); Writespaceline (20-LineNum, True); Close (F1); Close (F2); Procedure Displaytext; VAR F1, F2: Text; TS: String [79]; Ch: char; i: integer; beginassign (f1, fn); reset (f1); assigncrt (f2); REWRITE (F2 ); I: = 0; RepeatreadLN (F1, TS); Writeln (F2, TS); INC (i); if i = 20 damEgini: = 0; ch: = readkey; end; until (ch = # $ 1b) OR EOF (F1); Close (F1); Close (F2); END; {Main program} BeGinwriteln ('sp version of the 44 dong zhanshan'); DirectVideo: = false; Writeln (copyright); ps1: = paramstr (1); ps2: = paramstr (2); ParseComline; IF not exist ('file not found!'); exit; end; if exist (ps2) Thenif Not Yesno ('file exist! overwrite') THEN EXIT; if Transzhen WS_ASCII (PS1); if Transzhen TranslateText ('$$$. $$$$, ps2) Else TranslateText (PS1, PS2); if Display Then Displaytext (PS2); if Print Then Exec (GetENV (' COMSPEC '),' / C Copy ' PS2 ' PRN> NUL '); if Erase THEN EXEC (GetENV (' COMSPEC '),' / C Del ' PS2 '> NUL '); if Transgen (Getenv (' COMSPEC '),' / C DEL $$$ $$$> nul '); End. §3.4 Source Program Paging Print After the program is written, if you want to print an output, in Basica, you can use the llist command to complete. For other advanced languages, the specific print command is missing, but it can also be implemented with the DOS function, but the output of the source program is higher, There is no universal command. In order to solve this difficult, use Turbo Pascal to write a source program print program ASL.PAS. §3.4.1 Program How to use ASL / H --- Get an ASL Help Text ASL File Name --- Pipe Printing Program ASL File Name / D - Page Display Source Program Description: "File Name" is a valid file name of DOS, you must write a full name. If you want to print a batch of files that extension .PAS, you can do: for %% a in (* .pas) do as anly %% a §3.4.2 Source Procedure List {Asl.Pas 1.2} {CopyRight (c) 1990, 94 dong zhanshan} Program AdvancedsourceLister; Uses Printer, DOS, CRT, ASTR VAR D1, M1, Y1, W1, PAGENUMBER, Counter, SP1, SP2: Word; Lin, Flnm, SW: String; F1, F2: Text; Function exist (flnm: string): boolean; var i: byte; f1: text; beginexist: = false; assign (f1, flnm); {$ I-} reset (f1); {$ I } i: = ioress; IF i = 0 damEginexist: = true; close (f1); end; Procedure PrintPagehead (VAR F3: Text); VAR i, H1, M, S, S100: Word; BegingeTtime (H1, M, S, S100); Writeln (F3, 'Advanced Print Program ", Space (SP1), FLNM, Space (SP2), Wordtostr (Y1, 4), '-', Wordtostr (M1, 2), '-', Wordtostr (D1, 2), Space (3), Wordtostr (H1, 2), ':', Wordtostr (M, 2), ':', Wordtostr (s, 2)); Writeln (F3, FillChartostr (80, '_')); end; procedure printpagetail (var f3: text); var i: word; begininc (Pagenumber); Writeln (F3, FillChartostr (80, '_')); Write (F3, FillChartostr (36, ')); Writeln (F3,' ---- ', Pagenumber,' ---- ' ); for i: = 1 to 12 do Writeln (f3); counter: = 0; Procedure Print; Begininc (Counter); Writeln (F3, Lin); if counter = 50 thenbeginprintpagetail (F3); PrintPagehead (f3); end; Procedure lastpageProcess (var f3: text); var i: integer; beginfor i: = counter 1 to 48 do Writeln (F3); PrintPageTail (f3); Procedure Processtab (var Lin: string); var temp, temp1: string; i: integer; ch: char; begintemp: = '; for i: = 1 to length (lin) dobeginch: = lin [i]; if ch = # 9 Temp1: = FillChartostr (8, ') else temp1: = ch; TEMP: = TEMP TEMP1; END; Lin: = Temp; Procedure p (var Lin); var Lin1: string; beginifleth (lin)> 80 thenbeginlin1: = lin; lin [0]: = CHR (80); if sw = '/ d' Then Print (f2) else Print (LST); DELETE (LIN1, 1, 80); Lin: = FillChartostr (4, ') LIN1; P (Lin); endelseif sw =' / d 'Ten Print (f2) else print (LST); END; BeGinwriteln ('ASL Version 1.2 Copyright (C) 1990, 94 dong zhanshan'); if paramstr (1) = '/ h' thnbeginwriteln ('Advanced Source Lister Usage:'); Writeln ('ASL / H --- ASL HELP Messenge '); Writeln (' ASL FileName); Writeln ('ASL FileName / D --- Display To Screen'); EXIT; End; Case Paramcount OF0: BeginWrite ('FileName : '); Readln (FLNM); SW: ='; End; 1: Beginflnm: = paramstr (1); SW: = '; end; 2: Beginflnm: = paramstr (1); SW: = paramstr 2); end; end; if not exist (File Not Found! '); EXIT; End; SP1: = 18 - Length (FLNM) DIV 2; SP2: = 36 - (SP1 Length (flnm )); lin: = flnm; flnm: = '; UpperLower (F1, flnm); reset (f1); if SW =' / d 'IBEGINASSIGNCRT (F2); REWRITE (F2); END; PAGENUMBER: = 0; counter: = 0; getdate (Y1, M1, D1, W1); if SW = '/ d' Then PrintPagehead (F2) Else PrintPagehead (LST); REATREADLN (F1, LIN); Processtab LIN); P (Lin); Until EOF (F1); if SW = '/ d' Then LastPageProcess (F2) Else LastPageProcess (LST); Close (F1); if SW = '/ d' Ten Close (F2); End.- --------------------------------------------- You are a wind It is sand, the forum is my home PS: "Sands" is my old ID, "water-wood sand": = "Snow people" newly registered a ID - Passbyword, or me. 2003-4-2 16:01:33 Sands Title: Webmaster Level: Administrator Prestige: 2 Articles: 927 Points: 1863 School: Anti-Japan Union Registration: 2002-8-4 § 3.5 Find and replace the program The Turbo Pascal system provides a very practical string lookup program grep.com, which can find one or have a string with a certain feature in a specified file, and it is displayed on the screen. However, it cannot replace the specified string to another string, however in actual work, we tend to replace the specified string in a batch of files, if you use the edit program, you need one one to do, It is unbearable. The author writes a simple string search and replacing the program Grep.PAS, after compiling to form the specified file under the operating system after compiling. §3.5.1 Program How to use GREP § 3.5.2 List of Source Procedures {Grep.Pas 1.0} {CopyRight (c) 1994 dong zhanshan} PROGRAM FIND_REPLACE; Uses dos; VARF1, F2: TEXT; FINDSTR, ReplaceStr: String; Findb, Replaceb: Boolean; Flnm: String; Procedure getcomline; beginflnm: = '; FINDSTR: ='; replaceStr: = '; FINDB: = FALSE; Replaceb: = false; case paramcount of2: beginflnm: = paramstr (1); FINDSTR: = paramstr (2) Findb: = true; end; 3: Beginflnm: = paramstr (1); FindStr: = paramstr (2); replaceStr: = paramstr (3); replaceb: = true; end; end; end; Procedure help; beginwriteln ('syntex: grep [replace string]'); Halt; end; Procedure Find; Varstr1: String; I, L: Word; Beginif FSearch (F1, ') =' 'TEN HELP; Assign (F1, F1, F1, F1, F1); RETIATREADLN (F1, STR1) ; inc (L); i: = POS (FindStr, Str1); IF i <> 0 thenwriteln ('[', flnm, '] line:', l, '', str1); Until Eof (F1); Close (f1); PROCEDURE Replace; VarsTR1, STR2, STR3: STRING; P: PathStr; D: DIRSTR; N: NameStr; E: ExtStr; i: integer Beginassign (F1, FLNM); Reset (F1); Assign (F2, 'Temp'); ReWrite (F2); RepeatreadLN (F1, Str2); Repeati: = POS (FindStr, Str2); if i <> 0 thenbeginstr3: = COPY (STR2, 1, I-1); Delete (STR2, 1, I Length (FINDSTR) -1); STR2: = STR3 ReplaceStr Str2; End; Until i = 0; Writeln (F2, STR2) Until EOF (F1); Close (F1); Close (F2); Assign (F1, FLNM); Assign (F2, 'Temp'); FSPLIT (P, D, N, E); str1: = n ' .bak '; Rename (F1, Str1); Rename (F2, FLNM); End; BeginWriteln (' Grep Version 1.0, Copyright (c) 1994 dong zhanshan '; getcomline; if flnm =' 'Then Help; if FINDB THEN IF replaceb the replace; end. §3.6 Backup Hard Disk Main Boot Sector Program §3.6.1 Hard Disk Main Boot Record When the hard disk is partitioned with fdisk, it generates a main boot record containing the partition information table and the main boot program in the 0 side of the hard disk. The role is to boost from the hard disk when the system is powered or reset. The ROM BIOS will read the contents of the hard disk to the 0000: 7C00 of the memory, and execute the main boot program, boot the operating system of the active partition to memory. The author writes backup the hard disk main boot sector program with Turbo Pascal, and the program list is included. The program is short and delicate, easy to use. §3.6.2 How to use Under the DOS system: HMR According to the programs, you can write the main boot record on the hard disk into the MRecord.sav; you can also write the content stored in the file mrecord.sav to the hard disk 0 face 0 according to the prompt. Column 1 sector. §3.6.3 List of Source Procedures {HMR.PAS 1.2} {CopyRight (c) 1990, 94 dong zhanshan} Program HarddiskmainbootRecord; Uses acrt, disk; ConstmbRF = 'mrecord.sav'; VARMP: Mbrt; i: integer; f1: file; Beginwriteln ('HMR Version 1.2 Copyright (C) 1990, 94 dong zhanshan', ^ m ^ j); if Yesno ('Read The Hard Disk Main Boot Record') ThenbeginProcessphysicalsector (2, $ 80, 0, 0, 1, 1, MP); if Yesno ('Save the hard disk main boot record') Thenbeginassign (F1, MBRF); REWRITE (F1, 1); BlockWrite (F1, MP, 512); Close (F1); End; End; IF Yesno ('Write the hard disk main boot record') Thenbeginif YESNO ('Are You Sure') Thenbeginassign (F1, MBRF); {$ I-} Reset (F1, 1); {$ I } i: = ioress; if i = 0 THENBEGINBLOCKREAD (F1, MP, 512); Close (F1); Processphysicalsector (3, $ 80, 0, 0, 1, 1, MP); endelse Writeln ('read file error'); end; end; writeln 7, 'DONE!', # 7); End. §3.7 Quad-PC text file conversion program Quartet advanced Chinese English typewriters have strong text processing, and IBM PC / XT, AT has a lot of flexibility, there are many excellent Chinese typography software available, so transfer files between four type typewriters and PCs Have certain necessity. The difference between the internal code of the four-way typewriter and the Han code of the PC CCDOS is mainly high bytes. The former high-level ASCII code is higher than the latter, and the difference in the different type of typewriter WP system The following file, each of which has two special edit characters before each soft return (its ASCII code is 8DH), and the ASCII code of the first character is 8EH. Through the above analysis, the author writes a program STPC.PAS for converting the Chinese text files of two machines with Turbo Pascal, which can be used by compiling the execution file. How to use: STPC PROGRAM STPC; VARF1, F2: File; CH, CH1: Char; Fil1, Fil2: String; Beginfil1: = paramstr (1); Fil2: = paramstr (2); Assign (F1, Fil1); Assign (F2, FIL2); Reset (F1, 1); REWRITE (F2, 1); RepeatBlockRead (F1, CH, 1); Case CH of # $ a1 .. # $ ff: BeginblockWrite (F2, CH, 1); Blockread (F1, CH, 1); CH1: = CHR (ORD (CH) $ 80); ch: = CH1 End; # $ 8e: BeginblockRead (F1, CH, 1); Blockread (F1, CH, 1); End; End; Blockwrite (F2, CH, 1); Until EOF (F1); Close (F1); Close (f2); § 3.8 SPT and BMP file two-way conversion program SPT is a black and white two-color graphic editor provided by Super-CCDOS. PainTbrush is a color graphic editing program provided by Windows. They have their own advantages. SPT provides the fine processing of the graphics, while PainTbrush The magnification reduction of graphics is not available. If the two programs can be exchanged directly, it is a pleasing thing. 3.8.1 Structure analysis of SPT and BMP file By analyzing the format of SPT and Paintbrush graphics files, the uncompressed Super Star graphic file (* .SPT) and PaintBrush BMP format file (* .bmp) are stored in a dot matrix (bit image). However, it is only the order of the order and the organizational method, so it can be used to perform data exchange using both files. The BMP format in Paintbrush has a monochrome bit image, a 16-color image, a 256 color bitmode, and a 24B bit image. Here only considers a format of the monochrome bit, in this format, 1bit ( Bit) represents a pixel point, 1b (bytes) represents 8 pixel points. There is a file header in the SPT file and the BMP file, which records the width, height, file length, and flag information of the graph. The SPT file head has 64B, as shown in Figure 3-1. The first 16b is the sign of the SPT file header, and the 34th byte begins for the two bytes of graphics width, which is the height of the graphic, and the unit is a pixel point. BMP's file header as shown in Figure 3-2, the first 2B is a flag, the latter 4b is the length of the file length (Longint), the 11th, 12th byte is a pointer to the dot matrix information, that is, from the third eH 1 word Start storage dot matrix data, the 19th, 20 bytes represent the graphics width, 23, 24 bytes represent height, the unit is also a pixel point, the 29th byte (01) indicates that the BMP file is a monochromatic bit image format. The BMP file head has a total of 62 bytes.殌 殌 SPT file logo 3910: 0100 敁 53 75 70 65 72 2D 53 74-61 72 20 46 69 6C 65 1A 敋 super-star file.3910: 0110 00 00 00 00 00 00 00 00 00 00 EE C3 f7 ................ 3910: 0120 40 00 敁 F0 03 敋敁 F4 01 敋 01 00 00 00 00 00 00 00 @ ....... ........ 3910: 0130 00 trillion 00-00 00 trillion ................ graphic pattern width height (1000 Point) (500 points) Figure 3-1.SPT graphics file header BMP file logo file length pointing point array information pointer 3910: 0100 敁 42 4D 敋敁 76 28 00 00 00 00 00 敁 3e 00 敋 00 00 28 00 bmv (... V ... .3910: 01100000 Dian Dian 7B 00 00 00 A0 00 Ge Ge -00000100 Dian Ge 01 00 00 00 {............. .. 3910: 012000000000 00 00 00 00 00 00 00 00 | ........... Graphic Width Graphic Height Monochrome Bit Image Format Sign (123 points) (160 points) Figure 3-2.Bmp graphic file header After the file header, the SPT and BMP files are the drawings of graphics, and the SPT file starts from the first line of graphics, and the second, third, ... , The N, the BMP file is exactly the opposite, which is the Nth, Nth-1 line, ..., first line, where n is the height of the graphic. The width of the graphic is width pixel point, the height is Height pixel point, because the SPT only takes only a multiplier of 8, so the number of bytes accounted for each row is (Width Div 8); width in the BMP file Arbitrary, but the number of bytes per line must be 4 times, so the actual number of bytes of bytes in each row is linebyte = (Width 7) DIV 8. According to the above analysis, a SPT_BMP.PAS program is written with Turbo Pascal to implement two-way conversion of the SPT and BMP files. Attention to two points when performing data conversion: (1) When the graphics are in the SPT system, you want to select the SuperStar file category, non-compressed storage format; (2) Open the Option file format in the Save File dialog box when the PaintBrush is map Option, select the monochromoe bitmap item, and then store. §3.8.2 Program How to use The method of use is: SPT_BMP switch has two options: / BS --- BMP file Convert to SPT file / SB --- SPT file to convert to BMP file §3.8.3 Source Procedure List {SPT_BMP.PAS 1.0} {CopyRight (c) 1994 dong zhenshan} Program Transfer_Spt_BMP; Constspt_head: Array [1..64] of byte = ($ 53, $ 75, $ 70,:/34,91,92,95,46, $ 69, $ 6c, $ 65, $ 1A, $ 00, $ 00, $ 00, $ 00, $ 00, $ 00, $ 00, $ 64, $ 40, $ 00, $ 00, $ 00, $ 00, $ 00, $ 00, $ 00, $ 00, $ 00, $ 00, $ 00, $ 00, $ 00, $ 00, $ 00, $ 00, $ 00, $ 00); BMP_HEAD: ARRAY [1 ..62] Of byte = ($ 42) Of Byte = 00, $ 00, $ 00, $ 00, $ 00, $ 00, $ 28, $ 00, $ 00, $ 00, $ 00, $ 00, 0000, $ 0000, y00, $ 00, $ 00, $ 00, $ 00, $ 00, $ 00, $ 00, $ 00, $ 00, $ 00, $ 00, $ 00, $ 00, $ 00, $ 00, $ 00, $ FF, $ FF, $ 00); Varbmp_File, SPT_FILE: STRING; CH: CHAR; BMP, SPT: File; OneLine: Array [1..1000] of char; width, height, bytes: word; linebyte, OFS, FileLength: longint; switch: string [3]; i: integer Procedure Disperror; Beginif iiSult <> 0 ThenbeginWriteln ('File Not Found!'); Halt; End; End; Procedure SPT_TO_BMP; VARI: INTEGER; Beginif POS ('.', SPT_FILE) = 0 THEN SPT_FILE: = SPT_FILE '.SPT'; if POS ('.', bmp_file) = 0 THEN BMP_FILE: = BMP_FILE '.BMP' Assign (SPT, SPT_FILE); {$ I-} Reset (SPT, 1); {$ I } Assign (BMP, BMP_FILE); REWRITE (BMP, 1); Seek (SPT, 34); BlockRead (SPT, Width , 2); Blockread (SPT, Height, 2); Bytes: = Width Div 8; linebyte: = ((Bytes 3) Div 4) * 4; FileLength: = FileSize (SPT); MOVE (FileLength, BMP_HEAD [3 ], 4); Move (Width, BMP_HEAD [19], 2); Move (Height, BMP_HEAD [23], 2); Blockwrite (BMP, BMP_HEAD, 62); for i: = bytes to linebyte do oneeline [i] : = # 0; for i: = height downto 1 dobeginofs: = bytes * (i-1) 64; Seek (SPT, OFS); BlockRead (SPT, OneLine, Bytes); Blockwrite (BMP, OneLine, Linebyte); End; Close (SPT); Close (BMP); End; Procedure Bmp_TO_SPT; VARI: Integer; Beginif Pos ('.', BMP_FILE) = 0 THEN BMP_FILE: = BMP_FILE '.BMP'; if POS ('.', SPT_FILE) = 0 THEN SPT_FILE: = SPT_FILE '.SPT'; Assign (BMP, BMP_FILE); {$ I-} RESET (BMP, 1); {$ I } Assign (SPT, SPT_FILE); REWRITE (SPT, 1 ); Seek (BMP, 18); Blockread (BMP, Width, 2); Seek (BMP , 22); BLOCKREAD (BMP, Height, 2); Bytes: = (Width 7) DIV 8; linebyte: = ((Width 31) Div 32) * 4; width: = bytes * 8; Move (Width, SPT_HEAD [35], 2); MOVE (Height, SPT_HEAD [37], 2); BlockWrite (SPT, SPT_HEAD, 64); for i: = height downto 1 dobeginofs: = linebyte * (i-1) 62; seek (BMP, OFS); BlockRead (BMP, OneLine, LinebyTe); Blockwrite (SPT, OneLine, Bytes); End; Close (BMP); Close (SPT); Procedure help; beginwriteln ('syntex: spt_bmp'); Halt; end; BeGinwriteln ('spt_bmp version 1.0 Copyright (c) 1994 dong zhanshan'); Case paramcount of0, 1, 2: help; 3: beginspt_file: = paramstr (1); bmp_file: = paramstr (2); switch: = paramstr (3 ); end; end; for i: = 2 to 3 do switch [i]: = UpCase (Switch [i]); if switch = '/ sb' Then SPT_TO_BMP; if Switch = '/ bs' THEN BMP_TO_SPT; END. 3.9 Database Saffler PDBC.PAS Each DBASE database file is a collection of data, which is the warehouse of data, and is the electronic bank of the data. Data From paper into the computer, it is convenient for querying. However, when the database is built and correcting, it is often printed to print a copy, with the retention of the database management software, the data results can be printed, but its printing speed is slower, when needed When a one outputs each record, use DBASE software, it is more troublesome. The author writes a program with Turbo Pascal. It uses the function provided by the DBASE unit of the second chapter to read the log structure of the DBase database file, and construct one Blank table, then read each DBase database record, fill it in a blank table, and finally enter into a text file. The process of using the program is: PDBC {PDBC.PAS 1.5} {CopyRight (c) 1991,94 dong zhanshan} Program printdbasecard; {DBASE database card printing program} Uses CRT, DOS, DBASE, ASTR; Constframe: array [1..11] of string [2] = ('┌', '┐', '└', '┘', '├', '┤', '┬', '┴', '┼ ',' ─ ',' │ '); type_line = array [1..50] of string; Varrecinfo: structype; {database structure} r: {record content} line_: _line; {card content} r: array [1..128, 1..2] of integer; {field in the card position} Numline : Integer; {Card Route} FL1, FL2: String [64]; {File Name} F1: File; {Database File Number} PROCEDURE TABLES; {Filling blank table Process} VAR i, K, M, StartRecord, OTextttr: Integer; FieldStr: string; ch: char; f2: text; beginassign (f2, fl2); Rewrite (F2); with Recinfo DobeGINWRITE 'Input Start Record (1 ..', NumR: 5, ') ---'); Readln (StartRecord); OTextttr: = Texttttr; Textattr: = Blink 0 * 16 15; WRITELN ('Working ... ... '); Textttr: = OTextattr; GetMem (REC, LengthRec); for m: = StartRecord to NumRec dobeginreadRecord (F1, M, Recinfo, REC); for i: = 1 to numfield dobeginwith Field ^ [i] dobegInfieldstr : = '; for K: = 1 To FldWidth Dofieldstr: = FieldStr Rec ^ [k fldoffset]; Move (FieldStr [1], LINE_ [R [i, 2] 1] [R [i, 1] 2], length (fieldstr)); end; end; for i: = 1 to Numline do Writeln (F2, Line_ [i]); Writeln (F2); End; End; Close (F2); end; procedure maketable {White Table Process} Var Temp1, Temp2: String; II, LL: Integer; FldWidth1: Integer; I, J, K, L, M, CW: Integer; _Start, _end: Boolean; Q, Q1: Integer; C, T: Array [1..16] of integer; function CalFldWidth (FieldNo: integer): integer; {field width calculation function} varFldWidth1: integer; beginwith Recinfo.Field ^ [FieldNo] dobeginif odd (length (FldName)) then FldName: = FldName # 32; if odd (FldWidth) THEN FLDWIDTH1: = FldWidth 1ELSE FLDWIDTH1: = FldWidth; CalfldWidth: = FldWidth1 Length (FldName) 4; end; end; Function Inn: Boolean; Var N: Integer; Beginfor N: = 1 to Q DOIF MM = C [N] ThenbeginN: = true; EXIT; END; INN: = FALSE; END; Procedure ChangeLine; {Networking Procedure} Var II: Word; BeginWhile K <= CW - 3 Dobegintemp2: = Temp2 # 32 # 32; if Not Inn (k) Temp1: = Temp1 Frame [10] Else Temp1: = Temp1 Frame [8]; INC (k, 2); end; if _Start Ten Temp1: = Temp1 frame [2] else temp1: = temp1 frame [6]; temp2: = temp2 frame [11]; line_ [ J]: = Temp1; Line_ [J 1]: = Temp2; INC (J, 2); Temp1: = Frame [5]; Temp2: = ''; K: = 3; if _Start Then _Start: = not_start ; = q1; for ii: = 1 to 16 do c [ii]: = T [II]; for II: = 1 to 16 DO T [II]: = 0; Q1: = 1; {MakeTable process start} begini: = 1; {field counter} j: = 1; {Router counter} k: = 3; {行 内 字 符 个 计 计}:::::::;;;;;;; Q: = 1; {Ring Table Corner Counter} Q1: = 1; {Ring Table Corner Counter} FldWidth1: = 0; _Start: = true; _end: = false; temp2: = '; temp1: = frame [1] For ii: = 1 to 16 DO C [II]: = 0; for ii: = 1 to 16 DO T [II]: = 0; Write ('Input Line Length (1..124) ---') ; readln (cw); L: = CalFldWidth (i); while not _end dobeginwith RecInfo.Field ^ [i] dobeginif odd (FldWidth) then FldWidth1: = FldWidth 1else FldWidth1: = FldWidth; temp2: = temp2 Frame [11 ] FLDNAME FRAME [11] Space (FldWidth1); for m: = 1 to length (fdname) DOBEGINIF Not Inn (k) THEN TEMP1: = Temp1 Frame [10] else if (m <> length (fldname I]) 1) TEMP1: = Temp1 Frame [8] Else Temp1: = Temp1 Frame [9]; INC; INC (k, 2); end; r [i, 1]: = K R [i, 2]: = j; T [Q1]: = K; Inc (Q1); if not Inn (k) Tenshen Temp1: = Temp1 Frame [7] else Temp1: = Temp1 Frame [9] ; INC (k, 2); if ingdomd (fldth) Then FldWidth1: = fldWidth 1ELSE FLDWIDTH1: = FldWidth; for m: = 1 To Fldwidth1 Dobeginif Not Inn (k) THEN TE MP1: = Temp1 Frame [10] Else IF M <> FldWidth1 1 THEN TEMP1: = Temp1 Frame [8] Else Temp1: = Temp1 Frame [9]; Inc (M); Inc (k, 2); End; INC (i); if i> recnfo.numfield the _end: = true; ll: = Calfldwidth (i); if _nd the changeelineelse if (ll k)> = CW - 1 Then Changeelsebegint [q1]: = k ; INC (Q1); if Not Inn (k) TEMP1: = Temp1 Frame [7] Else Temp1: = Temp1 Frame [9]; Inc (k, 2); end; end; end; temp1: = frame [3]; i: = 3; While i <= CW-3 DoBeginif Not Inn (i) Ten Temp1: = Temp1 Frame [10] Else Temp1: = Temp1 Frame [8]; Inc (I, 2); END; TEMP1: = Temp1 Frame [4]; line_ [J]: = Temp1; Numline: = J; End; Procedure Help; {Display Help Information} BeginWriteln ('Syntex: PDBC DBASE_FILENAME OUTPUT_FILENAME'); Halt; End; {Main program start} BeGinwriteln ('PDBC Version 1.5 Copyright (C) 1991, 94 dong zhanshan'); if paramcount <2 Then Help; FL1: = paramstr (1); if Fsearch (fl1, ') =' 'Then Exit; fl2: = paramstr (2); OpenDBase (FL1, F1, Recinfo); MakeTable; Tables; ClosedBase (F1, Recinfo); Writeln (# 7, # 7, 'end !!!'); end. ---------------------------------------------- you are a wind I am sand, the forum is my home PS: "Sands" is my old ID, "water-wood sand": = "Snow people" newly registered a ID - Passbyword, or me. 2003-4-2 16:01:50 Fengsha people title: webmaster level: administrator prestige: 2 Articles: 927 Points: 1863 martial art: anti-Japanese Union Registration: 2002-8-4 §3.10 BAT files Convert to COM program It is well known that the batch document has the advantages of writing and easy to use, and the amount of memory is less than the unique, especially after the version of DOS 3.30, and has added a number of new batch commands to make the batch file to make a hand. However, batch files are stored in ASCII code, which is both advantages and disadvantages. When you have written a software, you will use the batch file, there will be a phenomenon of leakage. How to compile the batch file as a command file, and get a certain degree of confidentiality? §3.10.1 Batch file (.bat) Sink to the technical principle of command file (.com) DOS function call 4BH is to perform an external program and selectively execute it, which is more troublesome. DOS also provides a soft interrupt of a call rule that is simple to interrupt 2EH, which is available to perform the requirements of the DOS internal and external commands. Interrupt 2 EH Call Rules: First use the DOS function to call 4ah, open up a suitable size buffer, then point the DS: Si to the command string length as the lead, the carriage return (0DH) is the resulting string to be executed for the suffix. Then perform an interrupt. After performing 2 eh, all registers except CS are destroyed, so before performing interrupt calls, the used register is protected, and the interrupt is returned to recover. In the batch file, you can divide the commands into the following categories: 1 internal command and external command, 2 label, 3 comments, 4 conditional statements, 5 transfer statements, 6 cyclic statements. For the first class command, you can use 2EH implementation directly; for the second class command, just construct a label in the appropriate place; for the third class command, during the compilation process, automatically delete; for the fourth class command To implement the comparison (CMP) and the transfer (JE, JNE, etc.); for the fifth class command, use unconditional hopping statement (JMP) to implement; and cycle statement, the for statement, you can treat it as a DOS command To use, just change the "%%" symbol to "%". The above types of commands are implemented, and then constructing several common subroutines can complete the conversion of BAT to COM files. A subroutine that needs to be constructed has a subroutine that performs 2 eh, performs subroutines returned by DOS and subroutines for obtaining DOS command line parameters. §3.10.2 Construction Compiler To convert the bat file to a COM file, you also need a valid compiler that interpreted the corresponding BAT file to the assembler code or machine code, form a valid ASM file or COM file, finally completed BAT to COM compilation. This article provides a demo B2c.PAS that converts the BATCH file to a COM file. §3.10.3 Source Procedure List {B2C.PAS 1.0} {CopyRight (c) 1993,94 dong zhanshan} Program translate_batch_to_com; Uses dos; CONSTBAT2COMHEAD: ARRAY [1..81] of byte = ($ BB, $ 00, $ 21, $ 0E, $ 1F, $ 2E, $ 8B, $ 0E, $ 51, $ 01, $ BE $ 51, $ 5B, $ 51, $ 83, $ C3, $ 0. $ 8A, $ 1C, $ 53, $ 56, $ 2E $ 8C, $ 2E $ 26, $ 2F, $ 01, $ c $ 2e, $ 0E, $ 26, $ 2E, $ 8B, $ 26, $ 4F, $ 01, $ 2E $ 8E $ 6 $ 5B, $ 59, $ 03, $ 01, $ 83, $ f9, $ 00, $ 75, $ CD, $ B8, $ 00, $ 4 C, $ CD, $ 21, $ C3, $ 00, $ 00, $ 00, $ 00); Varstr1: string; txtfl: text; bfl: file of char; buffer: array [1..10000] of char; flnm: string; Totalingth: Word; Procedure RemoveSpace (var str1: string); var i: word; begini: = POS ('', str1); if i = 1 thenbegindelete (str1, 1, 1); RemoveSpace (STR1); end; Procedure Removedouble; var i: word; begini: = POS ('%%', str1); delete (str1, i, 1); if not (POS ('%%', str1) = 0 ); paovedouble; End; Procedure Removeflowera (var str1: string); var i: word; begini: = POS ('@', str1); if i = 1 thendelete (STR1, 1, 1); END; Procedure Transfer; Var Strlen: Word; Cmnum: Word; CH: char; beginassign (txtfl, flnm); reset (txtfl); cmnum: = 0; CH: = char ($ 0d); Totallength: = 84; REPEATREADLN (TXTFL) , str1); RemoveSpace (str1); Removedouble (str1); RemoveFlowra (str1); strlen: = length (str1); inc (cmnum); Move (str1, buffer [totalingth), strlen 1); Totallength: = Totallength Strlen 1; Move (CH, Buffer [Totallength], 1); Inc (TOTALLENGTH); Until EOF (TXTFL); Move (Cmnum, Buffer [82], 2); Close (TXTFL); Procedure writebat2com; var i: word; begini: = POS ('.', flnm); str1: = Copy (flnm, 1, i-1); str1: = str1 '.com'; Move (Bat2comhead, Buffer, 81); Assign (BFL, STR1); REWRITE (BFL); for i: = 1 to Totallength Do Write (BFL, Buffer [I]); Close (BFL); Procedure help; beginwriteln ('syntex: b2c batch_filename); Halt; end; BeGinwriteln ('B2C Version 1.0 Copyright (C) 1993, 94 dong zhanshan'); Case paramcount of0: Help; 1: flnm: = paramstr (1); else help; end; if fsearch (flster, '') = '' THEN HELP; §3.11 Effective destruction of confidential documents When a DOS file is deleted, it does not remove anything from the disk, which provides a chance to recover files. If some people have suitable software, they can illegally view data that they have destroyed by users. Norton Utilities and PC Tools have utilities to actually delete files physically, and avoid files being recovered, resulting in leakage. If there is no such software in your hand, you can use the following WiPE.PAS programs to achieve the same functionality. When you run a WIPE program, type the file name that you want to delete as the command line parameter. Once the user confirms that it does want to delete the file, the program is wiped off the secret data that needs to be removed according to the US Department of Defense DOD5220.22M standard. The file to be deleted is first written as '0', then written to '1', so repeated 3 times, then written a random value. Plus the steps not described in a DOD standard, that is, before deleting, first change the file name to a single character file name, such as 'X', you can use the recovery program to restore the confidential file. Source program list: {wipe.pas 1.0} {CopyRight (c) 1994 dong zhanshan} Program wipe_file; {$ I-, S-, R-} Uses acrt; VARF: FILE; PASS: Inteder; CH: CHAR; Procedure stop; beginwriteln ('error wiping file'); Halt; end; Beginif iRrorcheck; Beginif iiSult <> 0. Procedure WiPewith (var f: File; CHAR); VAR i: longint; r: word; beginReset (f, 1); errorCheck; for i: = 1 to FileSize (f) dobeginblockwrite (f, c, 1, r ); if r <> 1 dam; end; close (f); errorCheck; BeGinwriteln ('Wipe Version 1.0 Copyright (C) 1992 Vincent D. O'''conner'); if paramcount <> 1 ThenbeginWriteln ('Syntex: Wipe'); EXIT; End; if Not Yesno ('Are you sure') THEN Halt; randomize; assign (f, paramstr (1)); errorCheck; for pass: = 1 to 3 dobeginwipewith (f, # 0); Wirewith (f, # 1); end; Wirewith (f, chr (random (256 )))))); Rename (f, 'x'); errorCheck; ERASE (f); errorCheck; Writeln ('Done!', # 7); end. §3.12 Release Memory Procedure Currently, a good TSR software should be removed from memory in time without need, and completely use the memory that TSR occupies to use it for other programs. For example, CCDOS2.13H / SPDoS6.0F, etc., there are also some software that cannot be evacuated from memory after running, waste memory space, such as SPDOS 5.0 / UCDOS 1.0, etc. Since the DOS operating system has 640K regular memory restrictions, if you cannot effectively control and release various TSR programs in memory, you will find the incapable memory when you run some large software, often have to restart the system, which is not only Wasted valuable time, and it is also easy to damage the machine. To release the memory resources for the TSR software application in memory, first we want to recover the interrupt vector table before running the TSR software, followed by releasing the memory resources to TSR. We know that the memory allocation block must be established when the DOS is loaded, which is composed of a 16-byte long memory control block (MCB) and a two parts of the inner memory block. If multiple programs have established multiple memory allocation blocks, these allocation blocks form a memory control chain in memory, with DOS service 52h, you can know the address of the first memory control block, which is useful for releasing memory resources. The first domain of the memory control block is 1 byte flag, and 4DH indicates that the memory control chain has not ended, and the end is completed at 05h. The second domain is 2 bytes long, the address of the program's PSP. The third field is 2 bytes long, and the length of the memory allocation block, we add the address of the current memory control block to the third domain value, the result is the address of the next memory control block, which will be used when the memory is released . When we find the memory control block belonging to the TSR, the memory can be released through the DOS service 49h, and the memory control block is added to the ES register before calling this function. Repeat this process, move from one memory control block to another memory control block and release it until the last piece. According to the above principles, a memory resource release program RMEM.PAS is written with Turbo Pascal, which modifies the 5H interrupt vector. This procedure should be performed before the TSR program to be released. When you need to clear the memory, press the Print Screen button to release the memory that the program is released. This program only needs to be executed, you can use multiple times. Source program list: {RMem.Pas 1.0} {CopyRight (c) 1994 dong zhenshan} {$ M 1024, 0, 0} program release_memory; Uses dos; TypeInTab = array [1..255] of longint; varinta: INTAB; I: Integer; R: registers; p: pointer; mcb, mcb1nd, mcb2nd, tsrps: word; str, flag: byte; Procedure ramtsr; interrupt; label endl; beginr.ah: = $ 52; msdos (r); mcb2nd: = MEMW [R.ES: R.BX-2]; while (MEM [MCB2END: 0]) = $ 4D DOMCB2END: = MCB2END MEMW [MCB2END: 3] 1; if MCB2END = McB1END THEND1END1ENDL; MCB: = McB1END; for i: = 0 to 255 DOMEML [0: 4 * i]: = INTA [i]; while (MEM [MCB: 0] = $ 4D) DOBEGINTSRPSP: = MEMW [MCB: 1]; R.AH: = $ 49; R. E: = MCB 1; MSDOS (R); MCB: = MCB MEMW [MCB: 3 ] 1; end; endl: r.ah: = 0; R.AL: = 3; INTR ($ 10, r); end; beginflag: = 10; GetInetVec ($ 78, p); Move (p ^, STR, 1); if str = flag dameginwriteln ('Release Memory Has Installed!'); EXIT; EndelseSetintVec ($ 78, @ flag); R.AH: = $ 52; MSDOS (R); mcb1end: = MEMW [R.ES :R .bx-2]; While (MEM [MCB1END: 0] = $ 4D) DOMCB1END: = MCB1END MEMW [MCB1END: 3] 1; Writeln ('Release Memory is Already!'); SetInetVec ($ 5, @ ramtsr) ; for i: = 0 to 255 dointa [i]: = MEML [0: 4 * i]; Keep (0); end. ---------------------------------------------- you are a wind I am sand, the forum is my home PS: "Sands" is my old ID, "water-wood sand": = "Snow people" newly registered a ID - Passbyword, or me. 2003-4-2 16:02:05 Snow Title: Webmaster Level: Administrator Prestige: 2 Articles: 927 Points: 1863 School: Anti-Japanese Union Registration: 2002-8-4 17th Floor All source procedures for this post: Click to browse this file and executable: Click to browse this file Source file file index table File name chapter Acrt.Pas 2.PAS 2.PAS 1.PAS 1.6 ar2.pas 1.6 ar3.pas 1.6 asl.pas 3.4 astr.pas 2.2 astr.asm 2.2 astrdemo.pas 2.2 b2c.pas 3.10 compdemo.Pas 2.11 Complex. PAS 2.11 cpasDemo.pas 1.3 cpasDemo.c 1.3 cpdemo.pas 1.3 cpunit.pas 1.3 ctopas.c 1.3 dbase.pas 2.5 dbdemo.pas 2.5 Disk.Pas 2.3 Disk.asm 2.3 DiskDemo.pas 2.6 EMS.PAS 2.6 Ems.asm 2.6 EMSDEMO.PAS 2.6 grep.pas 3.5 hdl.pas 3.2 hmr.pas 3.6 intr.pas 1.5 logtab.pas 1.4 Math.Pas 2.8 MathDemo.Pas 2.8 MATRDEMO.PAS 2.9 Matrix.Pas 2.9 mkbindat.pas 1.9 pdbc.pas 3.9 Popdemo. PAS 2.4 POPUP.PAS 2.4 prob.Pas 2.10 provelemo.pas 2.10 RMem.Pas 3.12 Simpson.Pas 1.4 sl.Pas 3.1 Softlock.asm 3.1 sp.pas 3.3 spt_bmp.pas 3.8 Stpc.Pas 3.7 Testbin.pas 1.9 Wipe.Pas 3.11 XMS.PAS 2.7 xms.asm 2.7 xmsdemo.pas 2.7 Appendix 2 Various display cards and display modalities Display Way Display Card / Graphics 0 CGA, EGA, VGA, MCGA, 3270 Text 1 Same as the same text 2 Same as the same text EH is above the same graphic FH on the same graphic 10h, the same pattern 11h MCGA, VGA pattern 12h VGA pattern 13h MCGA, VGA graphics Note: MDA monochrome card, CGA color card, EGA enhanced graphics card, MCGA multi-color graphics card, VGA video graphics card, 3270IBM3270 graphics card
