home *** CD-ROM | disk | FTP | other *** search
- {$M 20000, 20000}
- library PowrDll;
- { PowerBBS Development Add-On DLL }
- { (c) 1994 by Russell E. Frey }
-
- { This source code may be freely distributed. }
- { You may create a 3rd party DLL add-on to PowerBBS, and
- distribute it ROYALTY FREE. }
-
- { You may even modify this code and distribute it, so long as you
- note the modifications at the top of the code and keep ALL the
- comments here at the top.}
-
- { Be sure to announce your product on our BBS: 516-822-7396 and/or
- distribute shareware versions of your DLL on our BBS. We will do
- our best to help you distribute your product! }
-
- { If you translate this code to a different language, please consider
- making your translation FREEWARE and upload it to the BBS. Be sure
- to thoroughly debug your translation (you do not want to mess up
- the users record or they will not be happy!) }
-
- { Sample code in Borland Pascal 7.0 on writing an add-on DLL for PowerBBS }
-
- { This code can easily be translated to ANY language capable of writing a DLL }
- { To run this DLL, in PowerBBS MENU SETUP at the CGM option place a D [For
- DLL!]. Then in the description of command put the NAME of the actual
- DLL created. For example this file: POWRDLL.DLL would be placed in
- the description.
-
- When a user now selects the command PowerBBS will dynamically load
- POWRDLL.DLL. It will execute VERY FAST. This is an easy way to create
- a 3rd party add-on as if it was written inside of PowerBBS! The user
- will notice NO SLOWDOWN! }
-
- { PowerLang's RUN_DLL command may also be used to execute the DLL }
-
- { We welcome ALL your comments on the Power of PowerBBS's DLL }
- { We also welcome any questions you might have, but due to time }
- { constraints may not be able to help you in some cases (including
- debugging your code, etc). }
-
- { Be aware that this product is provided AS IS. We are not
- liable for ANY problems this DLL may cause. }
-
- uses
- WinDos,
- Strings,
- WinProcs,
- WinTypes;
-
- { Need Colors? Use the following in your Print_Modem calls:
-
- AFTER calling the CONVERT_MACROS procedure!
-
- @1@ Blue
- @2@ Green
- @3@ Cyan
- @4@ Red
- @5@ Magenta
- @6@ Gray
- @7@ Yellow
- @8@ Brown
- @9@ White
- @10@ Light Blue
- @11@ Light Green
- @12@ Light Cyan
- @13@ Light Red
- @14@ Light Magenta
- @15@ Light Gray
- @16@ Default Color
-
- Colors will ONLY be used if the caller has ANSI capabilities.
- }
-
- {-----------------------------------------------------------------------------}
- { User types to directly manipulate user information. }
- { NEVER MANIPULATE any information unless you are SURE of what you are doing! }
- {-----------------------------------------------------------------------------}
- Type
- packed_2_chars = array[1..2] of char;
- packed_3_chars = array[1..3] of char;
- packed_4_chars = array[1..4] of char;
- packed_5_chars = array[1..5] of char;
- packed_6_chars = array[1..6] of char;
- packed_7_chars = array[1..7] of char;
- packed_8_chars = array[1..8] of char;
- packed_9_chars = array[1..9] of char;
- packed_10_chars = array[1..10] of char;
- packed_11_chars = array[1..11] of char;
- packed_12_chars = array[1..12] of char;
- packed_13_chars = array[1..13] of char;
- packed_14_chars = array[1..14] of char;
- packed_15_chars = array[1..15] of char;
- packed_16_chars = array[1..16] of char;
- packed_19_chars = array[1..19] of char;
- packed_20_chars = array[1..20] of char;
- packed_23_chars = array[1..23] of char;
- packed_24_chars = array[1..24] of char;
- packed_25_chars = array[1..25] of char;
- packed_30_chars = array[1..30] of char;
- packed_39_chars = array[1..39] of char;
- packed_40_chars = array[1..40] of char;
- packed_32_chars = array[1..32] of char;
- packed_35_chars = array[1..35] of char;
- packed_45_chars = array[1..45] of char;
- packed_78_chars = array[1..78] of char;
- packed_128_chars = array[1..128] of char;
-
- {Specification of the PowerUser_Rec. variable which stores the current
- users information.}
- pPowrUser_Record = ^PowrUser_Record;
- PowrUser_Record = record
- name: packed_25_chars; {Name}
- Location: packed_20_chars; {City/Location}
- Computer: packed_15_chars; {Computer Type}
- Phone_Number: packed_14_chars; {Phone Number} {Home}
- Password: packed_10_chars; {Password}
- Birthday: packed_8_chars; {Date of birthday, DD/MM/YY}
- First_Call: packed_8_chars; {Date of first call, DD/MM/YY}
- Last_File_Scan: packed_8_chars; {Date of last file search, DD/MM/YY}
- Expiration_Date: packed_8_chars; {Expiration Date}
- Last_Call: packed_8_chars; {Date of last call, DD/MM/YY}
- Last_Time: packed_5_chars; {Time of last call, HH:MM}
- Calls: integer; {Total number of calls}
- uploads: integer; {Total number of uploads}
- downloads: integer; {Total number of downloads}
- Time_On: integer; {Minutes used TODAY}
- Today_Bytes: double; {Bytes downloaded TODAY}
- Download_Bytes: double; {Total bytes downloaded}
- Upload_Bytes: double; {Total bytes uploaded}
- JUNK: array[1..820] of byte;
- Qwk_Init: byte;
- QWK_Flag1,
- QWK_Flag2: byte;
- QWK_Flag3,
- QWK_Flag4: word;
- internaluse: byte;
- waiting_messages: word; { number of messages waiting }
- reservedb: byte;
- reservedl: longint;
- handle_new: byte;
- info_in_new_numbs: byte; {if<>200 then just junk in next fields:}
- chat_use_handle: boolean;
- qwk_msg_use_handle: boolean;
- data_phone: packed_14_chars;
- business_number: packed_14_chars;
- fax_number: packed_14_chars;
-
- bchat_exit: Byte; {if=200 use string}
- chat_exit: String[60];
- bchat_entry: Byte; {if=200 use string}
- chat_entry: String[60];
- Access: Byte; {Access Level}
- Expiration_Access: Byte; {Expired Access Level}
- Screen_Lines: Byte; {Length of a page}
- Safe_Total: Byte; {Time in Bank}
- Options: byte; {Option bits}
- {bit value 1 = expert; 4 = dead; 8 = hasmail; 16=TRUE,64=TRUE then 32=TRUE[MALE];FALSE[FEMALE]}
- Xproto: Char; {Protocol}
- Monitor_Type: Char; {Monitor? (M)onocrome (C)olor (N)one}
- Messages_Left: word; {total messages left by user}
- downbytes_month: double; {total bytes downloaded/month}
- downbytesmonth: byte;
- downbytes_month_max: word; {max downbytes/month}
- truebps2: packed_5_chars; {true baud rate}
- lang_num: byte; {current language number}
- is_focused: boolean; {used internally}
- powercomm_connect: boolean; {true if PowerComm
- connect}
- color_mode_connect: boolean; {true if PowerComm/
- color_mode connect}
- last_forum_on2: byte; {last forum joined}
- credits: longint; {amount of credits left}
- anony_name2: string[15]; {JUNK}
- script: array[1..37] of char; {used for scripts}
- auto_forum_join_set: char; { = 10 means use auto forum join! }
- auto_forum_join: integer;
- set_up_int_msgs: byte; { = 10 if use next two options! }
- max_internet_msgs_month: word;
- current_internet_msgs_month: word;
- the_internet_month: byte;
-
- allow_FTPmail: byte; {allow if = 10}
- dollars: word;
- call_verified: byte;
- anonymous_name: array[1..20] of char;
- has_anonyname: char; { if true, set to 10 }
- has_address: char; { if true, set to 10 }
- last_menu_code: byte;
- QWK_Net_User: byte; { if true, set to 10 }
- area_backnum: array[1..3] of char;
- last_forum_on: integer;
- created_rec: char; { if true, set to 10 }
- PowerUser_Ext_Num: word;
-
- address: array[1..50] of char; {address} {location above}
- state: array[1..10] of char; {state}
- zip: array[1..10] of char; {zip}
-
- call_backnum: array[1..7] of char; {Called Number}
- end;
-
- { The following record holds the forum information (all 1000 forums) }
- const
- highest_ext_forum_number = 999; { was 1000 }
-
- type
- { data structure for PowerUser_Rec.Forum }
- forum_data_options_record = record
- Options: byte; {Options}
- {bit value 1 = member
- 2 = 2
- 16= join_it}
- Message_Pointer: single; {Pointer to message last read}
- end;
-
- Array_Of_Forum_Ext = array[0..highest_ext_forum_number] of forum_data_options_record;
-
- pPowrUser_Record_Extension = ^PowrUser_Record_Extension;
- PowrUser_Record_Extension = record
- Delete_This: boolean;
- Forum_Data: Array_Of_Forum_Ext; {0..999}
- user_name: longint; { 32 bit CRC of user name }
- junk: byte;
- end;
-
- {Specification of the Power_CallInfo_Rec; holds the current caller's
- information (The USERINFO.BBS File) }
- pPower_CallInfo_Rec = ^Power_CallInfo_Rec;
- Power_CallInfo_Rec = record
- name: packed_25_chars; {User Name}
- User_Pointer: integer; {User Record # starting at 1}
- BaudRate: packed_5_chars; {Baud Rate to Send at}
- Com_Number: char; {Com Number to Send at}
- What_Menu: byte; {Current Menu}
- color_mode: char; {Gcolor_modeType:
- 'C' => Color
- 'M' => Monochrome
- 'N' => None}
- Access: byte; {User Access Level}
- ForumNum2: byte; {Current Forum Number}
- Logon_Time: packed_5_chars; {hh:mm Time of Logon}
- Logon_Mins: integer; {Time the user logged on in mins}
- Used_Today: integer; {Time the user used in
- previous calls so far today}
- time_limit: integer; {Maximum mins permitted on BBS}
- KDownload_Maximum:integer; {Maximum download bytes in K}
- Upload_Credit: integer; {Minutes given for Uploading}
- Minutes_Useable: integer; {Maximum time left for Caller}
- Node_Num: byte; {Node number of this CallInfo File}
- Path_Data: String[28]; {Path to PowrBBS.DAT}
- Forum_Num: integer;
- Whatsdoing2: char; {'P' - Live Program
- 'G' - Goodbye after transfer
- 'T' - Transfer}
- Trans_Type: char; {set to U for upload or D for download}
- Protocol: byte; {protocol # for transfers}
- Started: longint; {transfer, 'P' - Live Program}
- end;
-
- { structure of the forum setup }
- pPowerBBS_Forum_Structure = ^PowerBBS_Forum_Structure;
- PowerBBS_Forum_Structure = record
- forum_name: string[20]; {name of forum}
- forum_subsysop: packed_23_chars; {sub-sysop if any}
- is_anonymous: boolean; {true if anonymous
- messages may be entered}
- all_messages_public: boolean; {true if no private mail}
- forum_public: boolean; {true if open to all users}
- forum_min_access_level: integer; {min access needed for
- forum no matter what}
- forum_messagebase_path: string[31]; {path/filename of message
- base file}
- forum_newsfile: string[31]; {path/filename to news}
- forum_filelisting: string[31]; {path/filename to listing
- of file areas available}
- forum_filelisting_data: string[31]; {path/filename to data
- file containing
- information as to where
- file lists are}
- forum_download_dirs: string[31]; {list of download
- directories, that one
- may access to download
- files from}
- forum_upload_directory: string[31]; {upload directory}
- forum_upload_listing: string[31]; {listing of uploaded
- files}
- end;
-
- { MOST of the information located in the PowrBBS.Dat file }
- { Note that MANY variables contained in this record may contain JUNK
- or is part of something else used in PowerBBS.Dat. Be careful
- with what you use! }
- string30 = string[30];
- string55 = string[55];
- string90 = string[90];
- string100 = string[100];
- filename_type = string[50];
- pbbs_record = ^bbs_record;
- bbs_record = record
- BBS_Name: String30;
- Sysop_FirstName: String[10];
- Sysop_Last_Name: String[15];
- end_default: string[4];
- MAX_Obey_Ratio: Integer;
- Min_Msgs_Ratio: Integer;
- Min_Downfile_Ratio: Integer;
- Min_Downbyte_Ratio: Integer;
- Min_Msgs_Ratio2: Integer;
- Min_Downfile_Ratio2: Integer;
- Min_Downbyte_Ratio2: Integer;
- New_User_Level: Integer;
- Access_Level_Info: String30;
- Download_Restrict_File: String30;
- Upload_Access_File: String30;
- Users_Path: String30;
- Users_Path2: String30;
- Forum_Data_File: String30;
- Protocolinfo_file: String30;
- Transfer_FileList_File: String30;
- Security_File: String30;
- Transfer_Directory: filename_type;
- Activity_Log: String30;
- Tranlog_Path: String30;
- Opening: String30;
- Hello: String30;
- Birthday_File: String30;
- Expired_File: String30;
- Sysop_File: String30;
- Forum_Menu: String30;
- NewUser_Text: String30;
- No_Sysop_Chat: String30;
- enter_chat_file: String30;
- exit_chat_File: String30;
- Script_Text,QScript_File : String30;
- BadUsers_Names: String30;
- Read_Help_File: String30;
- Mail_Prefix: String[8];
- Most_Msgs_Downloadable: Integer;
- OS_Shell_File: String30;
- Begin_Download_File: String30;
- Begin_Upload_File: String30;
- Freefile_List: String30;
- Start_Batch: String30;
- Init_Modem_Command1,
- Init_Modem_Command2: String55;
- Nodes_Users_Info: String30;
- chatstatfile: string30;
- chattalkfile: string30;
- onetoonefile: string30;
- roominfofile: string30;
- run_xmodem1k: string;
- script_for_newusers: string30;
- answer_to_script: string30;
- credit_system: boolean;
- more_credits: string30;
- anony_info: string30;
- runanonybbs: boolean;
- lowbaudinfoscreen: string30;
- minimum_sec_to_abort_intro: integer;
- screen_enter_script_mode: string30;
- screen_end_script_mode: string30;
- Live_Programs_Menu: string30;
- Live_Programs_DataFile: string30;
- Chat_Help_File: string30;
- Most_Lines_Msg: integer;
- minimum_baud: longint;
- Modem_Offhook: string30;
- Read_Mail_Menu: string30;
- aux_addr1: word;
- cardtype: word;
- cardseg: word;
- (* --------------------Event Information------------------------------*)
- old_active_event: Boolean;
- old_time_of_event: String[5];
- old_Wait_For_Event: Boolean;
- (* --------------------- Test Files ----------------------------------*)
- TestFiles: Boolean;
- TestBatch: String30;
- TestFile1: String30;
- TestFile2: String30;
- (*--------------------------------------------------------------------*)
- Private_Uploads_Only: Boolean;
- Private_Upload_Directory: String30;
- Private_Upload_List: String30;
- Bulletins_Menu: String30;
- Bulletins_Data: String30;
- Baud_Rate_Open_At: packed_5_chars;
- LockBaud: boolean;
- ClosedBBS: Boolean;
- Port_Number,Port_Number2: String[6];
- Port_Number3: array[0..6] of char;
- RingAnswer: boolean;
- Max_Pause_Time: Integer;
- UseRealName: Boolean;
- AllowBadChars: Boolean;
- Permit_Ansi_Messages: Boolean;
- News_New: Boolean;
- Turn_Off_FreeCheck: Boolean;
- Minimum_Space_Uploads: Integer;
- Default_AnsiColor: String[4];
- Default_AnsiIntensity: String[4];
- Transfer_Figure_Time: Real;
- Pack_QWK_Files: String30;
- View_ZIP_File: filename_type;
- Test_ZIP_File: filename_type;
- Bad_archive: filename_type;
- IndexPath: string30;
- IndexRamdiskPath: string30;
- StatsScreen: string30;
- PowerInfoPath: string30;
- SerialNumber: string;
- AskBirthdate: boolean;
- NonEchoChar: char;
- DeleteDropUploads: boolean;
- FilesRatiosScreen: string30;
- LogFileName: String30;
- TranString: String30;
- NSPath: string30;
- Monitor_File: string30;
- PermitHandles: boolean;
- FrontDoorBatch: string30;
- QuitBatchFile: string30;
- TheListPath: string30;
- UpdateScreen: string30;
- ClockScreen: string30;
- QuestionClosed,AnswerClosed: string30;
- LangInfoFile: string30;
- BadRatioFile: string30;
- Source_MNU_POW_Dir: string30;
- irq_modem: string30;
- modem_base1: word;
- modem_base2: string30;
- MultiLanguage: boolean;
- UseDtr: boolean;
- UsePowerMail: boolean;
- UseFrontDoor: boolean;
- Expiration_Warning: string30;
- PNET_Tagline: string[60];
- MODEM_ATHO: string30;
- date_format: byte; { 0 = US MM-DD-YY; 1 = DD-MM-YY }
- event_data_file: string30;
- minimum_sec_new_files: integer;
- use_fax: boolean;
- show_whose_online: boolean;
- show_dialog_on_startup: boolean;
- doorsys_path: string30;
- track_gender: boolean;
- Start_Up_Minimized: boolean;
- Internet_Connection: boolean;
- PowerBase_Code: string30;
- SysopPage_DataFile: string30;
- TheWav: string100;
- Bytes_upload_Credit: Word;
- Bytes_Dn_Up_Credit: Word;
- Credits_To_Uploader: Word;
- Caller_ID: Boolean;
- Show_Stats: Boolean;
- Minimum_Access_For_Internet: Integer;
- forum_network_file: string30;
- cbv_onoff,
- blts_onoff: boolean;
-
- Caller_ID_Name: string100;
- Caller_ID_Phone: string100;
-
- areacodefile: string100; {CALL1}
- callbackfile: string100; {CALL2}
- begincallback:string100; {CALL3}
- badnumbers: string100; {CALL4}
- security_change: string100; {CALL5}
- tempo: string;
- Start_PowerBBS_Directory: string100;
- lastdirl: string90;
-
- QWK_Blts,
- QWK_NewFiles,
- QWK_UpNewFiles,
- QWK_ALLNewFiles,
- QWK_GOODBYE,
- QWK_NEWS,
- QWK_WELCOME,
- QWK_FileEnclos,
- QWK_ALLFileEnclos,
- QWK_PromptFileEnclos,
- QWK_Logoff: boolean;
- QWK_MaxConf,
- QWK_Max_QWK: word;
-
- marked_mail: string;
- credit_name: string30;
- credit_bytes: string30;
-
- temps1, temps2, temps3, temps4: string;
- temps5: string;
- end;
-
- {-----------------------------------------------------------------------------}
- { Just conversions. itoa and atoi in C. }
- {-----------------------------------------------------------------------------}
- function int_to_asc (int: integer): string;
- { Converts an integer to string }
- var
- tstr: string;
- begin
- str(int, tstr);
- int_to_asc := tstr;
- end;
-
- function asc_to_int (InString: String): integer;
- var
- i: integer;
- value: integer;
- num: String;
-
- begin
- num := '';
- for i := 1 to length(InString) do
- if (InString[i] >= '0') and (InString[i] <= '9') then
- num := num + InString[i];
-
- if length(num) = 0 then
- value := 0
- else
- val(num, value, i);
-
- asc_to_int := value;
- end;
-
- {-----------------------------------------------------------------------------}
- { Sample procedures to interface with PowerBBS. }
- {-----------------------------------------------------------------------------}
-
- {-----------------------------------------------------------------------------}
- Procedure Print_Modem(PBBSWin: HWND;
- ToWrite: String);
- { Prints the String TOWRITE to the screen and caller }
- var
- pToWrite: array[0..254] of char;
-
- begin
- StrPcopy(pToWrite, ToWrite);
- SendMessage(PBBSWin, WM_COMMAND, 10001, longint(@pToWrite));
- end;
-
- {-----------------------------------------------------------------------------}
- Procedure Println_Modem(PBBSWin: HWND;
- ToWrite: String);
- { Prints the String TOWRITE followed by a carriage return to screen and caller }
- var
- pToWrite: array[0..254] of char;
-
- begin
- StrPcopy(pToWrite, ToWrite+#13);
- SendMessage(PBBSWin, WM_COMMAND, 10001, longint(@pToWrite));
- end;
-
- {-----------------------------------------------------------------------------}
- Procedure Get_Enter_Key(PBBSWIN: HWND);
- { Outputs to the user to press their enter key, waits till its pressed,
- and clears the output that says Press [Enter]: }
-
- begin
- SendMessage(PBBSWin, WM_COMMAND, 10002, 0);
- end;
-
- {-----------------------------------------------------------------------------}
- Procedure Ask_User(PBBSWIN: HWND;
- Var InputS: String;
- MaxIn: Integer);
- { Inputs characters from a user. }
- var
- pIn: Array[0..254] of char;
-
- begin
- StrPcopy(pIn, int_to_asc(MaxIn));
- SendMessage(PBBSWIN, WM_COMMAND, 10003, longint(@pIn));
- InputS := StrPas(pIn);
- { Note that command 10003 you send PowerBBS the maximum number of
- input chars. It then uses this SAME pointer to send back the
- actual input from the user. }
- end;
-
- {-----------------------------------------------------------------------------}
- procedure clearscreen(PBBSWIN: HWND);
- { Clears the ANSI screen }
-
- begin
- SendMessage(PBBSWIN, WM_COMMAND, 10004, 0);
- end;
-
- {-----------------------------------------------------------------------------}
- function PauseStop(PBBSWIN: HWND): boolean;
- { this function will display ::: Pause [S]top, [C]ontinue ::: if
- the user is beyond their max lines/page. If the user presses
- S to Stop this function returns TRUE. Otherwise FALSE is
- pressed }
- var
- pIn: Array[0..254] of char;
-
- begin
- SendMessage(PBBSWIN, WM_COMMAND, 10005, longint(@pIn));
- PauseStop := (pIn[0] = 'Y');
- end;
-
- {-----------------------------------------------------------------------------}
- function Get_Key(PBBSWIN: HWND): char;
- { Waits for a key from the user. Returns the key pressed (note that
- if the carrier dropped carrier it returns char #255).
- *RETURNS THE UPPERCASE CHARACTER OF KEYPRESSED*}
-
- var
- pIn: Array[0..5] of char;
-
- begin
- SendMessage(PBBSWIN, WM_COMMAND, 10006, longint(@pIn));
- Get_Key := pIn[0];
- end;
-
-
- {-----------------------------------------------------------------------------}
- function Get_YN(PBBSWIN: HWND): boolean;
- { Waits until the user presses Yes or No. (note that it COULD be
- different from a Y if a different LANGUAGE is being used) }
- var
- pIn: Array[0..5] of char;
-
- begin
- SendMessage(PBBSWIN, WM_COMMAND, 10007, longint(@pIn));
- Get_YN := (pIn[0] = 'Y');
- end;
-
- {-----------------------------------------------------------------------------}
- function Get_YesNoQ(PBBSWIN: HWND;
- TheQues: String;
- Default: Boolean): boolean;
- { Outputs the question THEQUES to the user. Then waits for a Y/N answer,
- with Default being the answer if the user presses the [ENTER] key.
- Returns the result }
-
- var
- PIn: array[0..254] of char;
-
- begin
- if Default then
- StrPcopy(Pin, 'Y'+TheQues)
- else
- strPcopy(Pin, 'N'+TheQues);
- SendMessage(PBBSWIN, WM_COMMAND, 10008, longint(@pIn));
- Get_YesNoQ := PIn[0] = 'Y';
- end;
-
-
- {-----------------------------------------------------------------------------}
- function Get_Hot(PBBSWIN: HWND;
- OKChars: String): Char;
- { Waits till the user presses a valid char in the OKChars string and
- returns that char (note: may not return a valid char if the user
- drops carrier). Ex: Get_Hot(PBBSWIN, 'YN') to wait for Y or N.
- Use UPPERCASE }
-
- var
- PIn: array[0..254] of char;
-
- begin
- StrPcopy(Pin, OKChars);
- SendMessage(PBBSWIN, WM_COMMAND, 10009, longint(@pIn));
- Get_Hot := PIn[0];
- end;
-
- {-----------------------------------------------------------------------------}
- Procedure Type_File_To_Modem(PBBSWIN: HWND;
- FName: String);
- { Types the file specified to the modem. }
-
- var
- PIn: array[0..254] of char;
-
- begin
- StrPcopy(Pin, Fname);
- SendMessage(PBBSWIN, WM_COMMAND, 10010, longint(@pIn));
- end;
-
- {-----------------------------------------------------------------------------}
- function Input_Key_Time(PBBSWIN: HWND;
- MaxTime: integer): char;
- { Waits up to MaxTime (in milliseconds) for a character to be entered.
- If the user does NOT press a key in this time, character #255 is
- returned. }
- var
- PIn: array[0..254] of char;
-
-
- begin
- StrPcopy(Pin, int_to_asc(MaxTime));
- SendMessage(PBBSWIN, WM_COMMAND, 10011, longint(@PIn));
- Input_Key_Time := PIn[0];
- end;
-
- {-----------------------------------------------------------------------------}
- procedure Send_Modem_Command(PBBSWIN: HWND;
- commands:string);
- { Sends commands to the modem and does NOT print commands on the local
- screen. }
- var
- PIn: array[0..254] of char;
-
-
- begin
- StrPcopy(PIn, commands);
- SendMessage(PBBSWIN, WM_COMMAND, 10012, longint(@PIn));
- end;
-
-
- {-----------------------------------------------------------------------------}
- function No_User_Online(PBBSWIN: HWND): boolean;
- { **************
- This is an IMPORTANT function. If this boolean is ever TRUE it should
- be the end of your DLL! So this NEEDS to be included in all loops,
- repeats, etc. If TRUE, then exit the loop, etc.. Example:
- Repeat
- Until (..) or (No_User_Online);
- }
- var
- pIn: Array[0..5] of char;
-
- begin
- SendMessage(PBBSWIN, WM_COMMAND, 10013, longint(@pIn));
- No_User_Online := (pIn[0] = 'Y');
- end;
-
- {-----------------------------------------------------------------------------}
- procedure Execute_Prog(PBBSWIN: HWND;
- commands:string);
- {
- Closes the com port. Executes commands, re-opens, and returns.
- }
-
- var
- PIn: array[0..254] of char;
-
-
- begin
- StrPcopy(PIn, commands);
- SendMessage(PBBSWIN, WM_COMMAND, 10014, longint(@PIn));
- end;
-
- {-----------------------------------------------------------------------------}
- function Key_Waiting(PBBSWIN: HWND): boolean;
- { Returns true if a key is waiting (could be either from the sysop's
- local keyboard or remote }
- var
- pIn: Array[0..5] of char;
-
- begin
- SendMessage(PBBSWIN, WM_COMMAND, 10015, longint(@pIn));
- Key_Waiting := (pIn[0] = 'Y');
- end;
-
- {-----------------------------------------------------------------------------}
- function Time_Left(PBBSWIN: HWND): integer;
- { Returns the time that the user has left }
- var
- pIn: Array[0..254] of char;
-
- begin
- SendMessage(PBBSWIN, WM_COMMAND, 10016, longint(@pIn));
- Time_Left := asc_to_int(StrPas(pIn));
- end;
-
- {-----------------------------------------------------------------------------}
- Procedure Verify_Time_Left(PBBSWIN: HWND);
- { PowerBBS checks the time left by User. If it is 0, the user is
- told their time is out. (No_User_Online would then be TRUE). }
-
- begin
- SendMessage(PBBSWIN, WM_COMMAND, 10017, 0);
- end;
-
- {-----------------------------------------------------------------------------}
- Procedure Write_ActLog(PBBSWIN: HWND;
- ToWrite: String);
- { Writes TOWRITE to the activity Log }
- var
- pIn: Array[0..254] of char;
-
- begin
- StrPcopy(pIn, ToWrite);
- SendMessage(PBBSWIN, WM_COMMAND, 10019, longint(@pIn));
- end;
-
- {-----------------------------------------------------------------------------}
- Procedure Convert_MACROS(PBBSWIN: HWND;
- Var ToConv: String);
- { Converts all |MACROS| }
- var
- pIn: Array[0..254] of char;
-
- begin
- StrPcopy(pIn, ToConv);
- SendMessage(PBBSWIN, WM_COMMAND, 10020, longint(@pIn));
- ToConv := StrPas(pIn);
- end;
-
-
- {-----------------------------------------------------------------------------}
- Procedure Change_Forum(PBBSWIN: HWND;
- InI: Integer);
- { Change to Forum InI }
- var
- pIn: Array[0..254] of char;
-
- begin
- StrPcopy(pIn, int_to_asc(InI));
- SendMessage(PBBSWIN, WM_COMMAND, 10021, longint(@pIn));
- end;
-
- {-----------------------------------------------------------------------------}
- Procedure Run_Menu_Command(PBBSWIN: HWND;
- InI: Integer);
- { Run_Menu_Command InI }
- var
- pIn: Array[0..254] of char;
-
- begin
- StrPcopy(pIn, int_to_asc(InI));
- SendMessage(PBBSWIN, WM_COMMAND, 10022, longint(@pIn));
- end;
-
- {-----------------------------------------------------------------------------}
- Procedure Run_PowerBase(PBBSWIN: HWND;
- InI: Integer);
- { Run PowerBase InI }
- var
- pIn: Array[0..254] of char;
-
- begin
- StrPcopy(pIn, int_to_asc(InI));
- SendMessage(PBBSWIN, WM_COMMAND, 10023, longint(@pIn));
- end;
-
- {-----------------------------------------------------------------------------}
- Procedure Back_Spaces(PBBSWIN: HWND;
- Num: Integer);
- { This procedure is used to back up and clear text. For example you could
- use: Press [ENTER]: then after ENTER is pressed, used this procedure to
- back up }
- var
- pIn: Array[0..254] of char;
-
- begin
- StrPcopy(pIn, int_to_asc(Num));
- SendMessage(PBBSWIN, WM_COMMAND, 10025, longint(@pIn));
- end;
-
- {-----------------------------------------------------------------------------}
- Procedure Send_File(PBBSWIN: HWND;
- Fname: string;
- mode: integer);
- { Sends filename FNAME [be sure to include full path/filename!]
- Mode:
- 1: zmodem
- 2: xmodem/crc
- 3: xmodem/1k
- 4: xmodem/1kg
- 5: ymodem
- 6: ymodemg }
- var
- PIn: Array[0..254] of Char;
- Outs: String;
-
- begin {Send_File}
- Outs := int_to_asc(mode)+'~'+Fname;
- StrPcopy(pIn, Outs);
- SendMessage(PBBSWIN, WM_COMMAND, 10026, longint(@pIn));
- end; {Send_File}
-
-
- {-----------------------------------------------------------------------------}
- Procedure Receive_File(PBBSWIN: HWND;
- Fname: string;
- mode: integer);
- { Receives Fname. Only uses the FILENAME in Fname. The file
- is placed in the transfer directory. BBS_RECORD^.Transfer_Dir
- Mode:
- 1: zmodem
- 2: xmodem/crc
- 3: xmodem/1k
- 4: xmodem/1kg
- 5: ymodem
- 6: ymodemg }
- var
- PIn: Array[0..254] of Char;
- Outs: String;
-
- begin {Send_File}
- Outs := int_to_asc(mode)+'~'+Fname;
- StrPcopy(pIn, Outs);
- SendMessage(PBBSWIN, WM_COMMAND, 10027, longint(@pIn));
- end; {Send_File}
-
- Function Monitor_Mode(PBBSWIN: HWND): Char;
- { Returns the color mode:
- 'R' = RIP
- 'C' = ANSI
- 'M' = ASCII
- Note that RIP is also ANSI compatible.
- }
- var
- PIn: Array[0..10] of Char;
-
- begin
- SendMessage(PBBSWIN, WM_COMMAND, 10028, longint(@pIn));
- Monitor_Mode := pIn[0];
- end;
-
-
- {-----------------------------------------------------------------------------}
- Procedure Get_UserRec(PBBSWIN: HWND;
- var user: pPowrUser_Record);
- {
- Gives you the pointer to the actual location of the user record in memory.
- By changing the actual information in this record you are able to change
- the current user information! (BE CAREFUL ON WHAT YOU DO!)
- }
- var
- pIn: array[0..254] of char;
- pc: pchar;
- pl: array[0..3] of byte absolute pc;
-
- begin
- SendMessage(PBBSWIN, WM_COMMAND, 10030, longint(@pIn));
- pl[0] := byte(pIn[0]);
- pl[1] := byte(pIn[1]);
- pl[2] := byte(pIn[2]);
- pl[3] := byte(pIn[3]);
- user := pPowrUser_Record(pc);
- end;
-
- {-----------------------------------------------------------------------------}
- Procedure Get_ForumUserRec(PBBSWIN: HWND;
- var fuser:pPowrUser_Record_Extension);
- {
- Gives you the pointer to the actual location of the user forum record in
- memory. This record contains the user's last read pointers along with
- the information containing which forums the user has access to.
- }
- var
- pIn: array[0..254] of char;
- pc: pchar;
- pl: array[0..3] of byte absolute pc;
-
- begin
- SendMessage(PBBSWIN, WM_COMMAND, 10031, longint(@pIn));
- pl[0] := byte(pIn[0]);
- pl[1] := byte(pIn[1]);
- pl[2] := byte(pIn[2]);
- pl[3] := byte(pIn[3]);
- fuser := pPowrUser_Record_Extension(pc);
- end;
-
- {-----------------------------------------------------------------------------}
- Procedure Get_CallInfo(PBBSWIN: HWND;
- var cuser:pPower_CallInfo_Rec);
- var
- pIn: array[0..254] of char;
- pc: pchar;
- pl: array[0..3] of byte absolute pc;
-
- begin
- SendMessage(PBBSWIN, WM_COMMAND, 10032, longint(@pIn));
- pl[0] := byte(pIn[0]);
- pl[1] := byte(pIn[1]);
- pl[2] := byte(pIn[2]);
- pl[3] := byte(pIn[3]);
- cuser := pPower_CallInfo_Rec(pc);
- end;
-
-
- {-----------------------------------------------------------------------------}
- Procedure Get_Current_ForumInfo(PBBSWIN: HWND;
- var forum:pPowerBBS_Forum_Structure);
- var
- pIn: array[0..254] of char;
- pc: pchar;
- pl: array[0..3] of byte absolute pc;
-
- begin
- SendMessage(PBBSWIN, WM_COMMAND, 10033, longint(@pIn));
- pl[0] := byte(pIn[0]);
- pl[1] := byte(pIn[1]);
- pl[2] := byte(pIn[2]);
- pl[3] := byte(pIn[3]);
- forum := pPowerBBS_Forum_Structure(pc);
- end;
-
- {-----------------------------------------------------------------------------}
- Procedure Get_BBS_Record(PBBSWIN: HWND;
- var bbs: pBBS_Record);
- var
- pIn: array[0..254] of char;
- pc: pchar;
- pl: array[0..3] of byte absolute pc;
-
- begin
- SendMessage(PBBSWIN, WM_COMMAND, 10034, longint(@pIn));
- pl[0] := byte(pIn[0]);
- pl[1] := byte(pIn[1]);
- pl[2] := byte(pIn[2]);
- pl[3] := byte(pIn[3]);
- bbs := pBBS_Record(pc);
- end;
-
-
- {-----------------------------------------------------------------------------}
- Procedure End_Call(PBBSWIN: HWND);
- { End The Call }
-
- begin
- SendMessage(PBBSWIN, WM_COMMAND, 10024, 0);
- end;
-
- {-----------------------------------------------------------------------------}
- Function Search_UserName(PBBSWIN: HWND;
- TheName: String): Integer;
-
- { Searches the UserDatabase for TheName. If not found, returns 0.
- If found, returns the record number that TheName is contained within. }
-
- var
- PIn: array[0..254] of char;
-
- begin
- strPcopy(PIn, TheName);
- SendMessage(PBBSWIN, WM_COMMAND, 10040, longint(@pIn));
- Search_UserName := asc_to_int(StrPas(pIn));
- end;
-
- {-----------------------------------------------------------------------------}
- Procedure Load_UserRec(PBBSWIN: HWND;
- var user: pPowrUser_Record;
- usernum: integer);
- {
- You must allocate memory for user before calling this routine!
- UserNum signifies the actual user record number (ask returned
- by Search_UserName)
- }
- var
- pIn: array[0..254] of char;
-
- begin
- strPcopy(pIn, int_to_asc(usernum));
- SendMessage(PBBSWIN, WM_COMMAND, 10041, longint(@pIn));
- SendMessage(PBBSWIN, WM_COMMAND, 10042, longint(@(user^)));
- end;
-
-
- {-----------------------------------------------------------------------------}
- Procedure Save_UserRec(PBBSWIN: HWND;
- var user: pPowrUser_Record;
- usernum: integer);
- {
- You must allocate memory for user before calling this routine!
- UserNum signifies the actual user record number (ask returned
- by Search_UserName)
- }
- var
- pIn: array[0..254] of char;
-
- begin
- strPcopy(pIn, int_to_asc(usernum));
- SendMessage(PBBSWIN, WM_COMMAND, 10041, longint(@pIn));
- SendMessage(PBBSWIN, WM_COMMAND, 10043, longint(@(user^)));
- end;
-
- {-----------------------------------------------------------------------------}
- Procedure Close_ComPort(PBBSWIN: HWND);
- { Closes the com port. }
-
- begin
- SendMessage(PBBSWIN, WM_COMMAND, 10044, 0);
- end;
-
- {-----------------------------------------------------------------------------}
- Procedure Open_ComPort(PBBSWIN: HWND);
- { Opens up the Com Port. }
-
- begin
- SendMessage(PBBSWIN, WM_COMMAND, 10045, 0);
- end;
-
- {-----------------------------------------------------------------------------}
- Procedure HangUp_Caller(PBBSWIN: HWND);
- { Attempts to hangup the caller.
- (Note that after 4 tries it gives up, if the caller is still on-line) }
-
- begin
- SendMessage(PBBSWIN, WM_COMMAND, 10046, 0);
- end;
-
- {-----------------------------------------------------------------------------}
- Function Number_Users_Online(PBBSWIN: HWND): integer;
- { Returns the number of users currently on-line. }
- { Only returns NON-ZERO nodes (So if a sysop has a BBS with a node 0 that
- node is not counted. }
- var
- PIn: array[0..30] of char;
-
- begin
- SendMessage(PBBSWIN, WM_COMMAND, 10047, longint(@PIn));
- Number_Users_Online := asc_to_int(StrPas(PIn));
- end;
-
- {-----------------------------------------------------------------------------}
- {
- In order to send a message first call Init_Message with the header.
- Then call Message_Line TOTAL_LINES Number of times. Each with the
- actual line of text for the message.
- Then call Save_Message.
- }
- Procedure Init_Message(PBBSWIN: HWND;
- From: String90; { Person Sending Message }
- Tou: String90; { Message destination }
- Topic: String90; { Subject of message }
- Total_Lines: Integer; { Total lines in message }
- Forum_Num: Integer; { Forum number to save in }
- Private: Boolean); { TRUE = Private message }
- var
- Pin: array[0..254] of char;
-
- begin
- strPcopy(PIn, From+'~'+Tou+'~'+Topic+'~'+int_to_asc(Total_Lines)+'~'+
- int_to_asc(forum_num));
- if Private then
- strcat(PIn, 'Y')
- else
- strcat(PIn, 'N');
-
- SendMessage(PBBSWIN, WM_COMMAND, 10050, longint(@PIn));
- end;
-
- Procedure Message_Line(PBBSWIN: HWND;
- TheLine: String);
- var
- PIn: array[0..254] of char;
-
- begin
- strPcopy(PIn, TheLine);
- SendMessage(PBBSWIN, WM_COMMAND, 10051, longint(@PIn));
- end;
-
- Procedure Save_Message(PBBSWIN: HWND);
-
- begin
- SendMessage(PBBSWIN, WM_COMMAND, 10052, 0);
- end;
-
- {-----------------------------------------------------------------------------}
- Procedure Set_Node_Description(PBBSWIN: HWND;
- Doing: String);
- { Sets the WHO IS ONLINE RECORD to what the user is doing.
- Ex: Set_Node_Description(PBBSWIN, 'Using 3rd party door.'); }
- var
- PIn: array[0..254] of char;
-
- begin
- StrPcopy(PIn, Doing);
- SendMessage(PBBSWIN, WM_COMMAND, 10053, longint(@PIn));
- end;
-
- function is_user_online(PBBSWIN: HWND;
- thename: string): boolean;
- { Checks if THENAME is currently on-line as a user. If THENAME is on-line
- returns TRUE }
- var
- pIn: Array[0..254] of char;
-
- begin
- strPcopy(pIn, thename);
- SendMessage(PBBSWIN, WM_COMMAND, 10054, longint(@PIn));
- Is_User_Online := (pIn[0] = 'Y');
- end;
-
- {-- Main DLL Module --}
- {-- This procedure MUST be named as PowerBBS_Main. PowerBBS assumes this
- procedure exists as this is the name that it calls when dynamically
- loading the DLL upon call from the BBS. ---}
- Procedure PowerBBS_Main(PBBSWin: HWND); export;
- var
- Inputs: String;
- Counter: Byte;
- Puser: pPowrUser_Record;
- Fuser: pPowrUser_Record_Extension;
- Cuser: pPower_CallInfo_Rec;
- forum: pPowerBBS_Forum_Structure;
- bbs: pBBS_Record;
- unum: integer;
- Puser2: pPowrUser_Record;
-
- begin
- ClearScreen(PBBSWin);
- Write_ActLog(PBBSWIN, 'Entering Our Test .DLL!');
- Inputs := '|NAME|';
- Convert_MACROS(PBBSWIN, Inputs);
- PrintLn_Modem(PBBSWin, 'Welcome '+Inputs);
- PrintLn_Modem(PBBSWin, 'PowerDLL (c)1994 by Russell E. Frey');
- PrintLn_Modem(PBBSWin, 'This demo does NOTHING special, other than TEST the capabilities of the DLL.');
- PrintLn_Modem(PBBSWin, '');
- Print_Modem(PBBSWin, 'Run Demo? ');
- if not Get_YN(PBBSWIN) then exit;
- { Now Test Pause }
- for counter := 1 to 13 do
- begin
- PrintLn_Modem(PBBSWin, 'This module is a DLL linked dynamically to PowerBBS!');
- PrintLn_Modem(PBBSWin, 'Now easily write addons in C, C++, Pascal, or any other language');
- PrintLn_Modem(PBBSWin, 'Capable of making simple Windows API Calls.');
- if PauseStop(PBBSWIN) then exit;
- if No_User_Online(PBBSWIN) then exit;
- end;
- Print_Modem(PBBSWin, 'What do you like about this? ');
- Ask_User(PBBSWIN, Inputs, 20);
- PrintLn_Modem(PBBSWin, 'You inputted ['+Inputs+']');
-
- Print_Modem(PBBSWIN, 'Press ONE KEY:: ');
- Inputs[1] := Get_Key(PBBSWin);
- Back_Spaces(PBBSWIN, 17);
-
- if Get_YesNoQ(PBBSWIN,'Did you like this program?',TRUE) then
- Println_Modem(PBBSWIN, 'Thanks!')
- else
- PrintLn_Modem(PBBSWIN, 'Thats ok. Oh BTW I just locked you out!');
- PrintLn_Modem(PBBSWIN, Inputs[1]);
- Print_Modem(PBBSWIN,'Press A B or C: ');
- Inputs[1] := Get_Hot(PBBSWIN, 'ABC');
- PrintLn_Modem(PBBSWIN, Inputs[1]);
- Type_File_To_Modem(PBBSWIN, 'C:\Autoexec.Bat');
- Print_Modem(PBBSWIN, 'Press ONE KEY (within one second):: ');
- Inputs[1] := Input_Key_Time(PBBSWin, 1000);
- if Inputs[1] = #255 then
- PrintLn_Modem(PBBSWIN, 'TimeOut!')
- else
- PrintLn_Modem(PBBSWIN, Inputs[1]);
- Send_modem_Command(PBBSWIN, '>>');
- {Execute_Prog(PBBSWIN, 'C:\TEMP.BAT');}
- if Key_Waiting(PBBSWIN) then
- PrintLn_Modem(PBBSWIN, 'Key Waiting')
- else
- PrintLn_Modem(PBBSWIN, 'NO KEY WAITING');
- Change_Forum(PBBSWIN, 3);
- Run_Menu_Command(PBBSWIN, 1);
- Run_PowerBase(PBBSWIN, 1);
- PrintLn_Modem(PBBSWin, 'Time Left: '+int_to_asc(Time_Left(PBBSWIN)));
-
- Get_UserRec(PBBSWin, pUser);
- PrintLn_Modem(PBBSWIN, 'Name = '+pUser^.Name);
- PrintLn_Modem(PBBSWIN, 'ZIP = '+pUser^.Zip);
-
- Get_ForumUserRec(PBBSWIN, Fuser);
- if (Fuser^.Forum_Data[3].Options and 1) <> 0 then
- PrintLn_Modem(PBBSWIN, ' You have access to forum #3!')
- else
- PrintLn_Modem(PBBSWIN, ' You do NOT have access to forum #3. <g>');
-
- Get_CallInfo(PBBSWIN, Cuser);
- PrintLn_Modem(PBBSWIN,'You are on at '+Cuser^.BaudRate+' bps! ');
-
- Get_Current_ForumInfo(PBBSWIN, forum);
- PrintLn_Modem(PBBSWIN,'Current Forum Name: '+forum^.forum_name);
-
- Get_BBS_Record(PBBSWIN, bbs);
- PrintLn_Modem(PBBSWIN, 'Opening File: '+bbs^.Opening);
- if Monitor_Mode(PBBSWIN) = 'R' then
- PrintLn_Modem(PBBSWIN, 'Using RIP')
- else
- if Monitor_Mode(PBBSWIN) = 'C' then
- PrintLn_Modem(PBBSWIN, 'Using ANSI')
- else
- PrintLn_Modem(PBBSWIN, 'Using ASCII');
-
- PrintLn_Modem(PBBSWIN, 'Rec # of GF = '+int_to_asc(Search_UserName(PBBSWIN,'GLEN FREY')));
- unum := Search_UserName(PBBSWIN, 'GLEN FREY');
- if unum <> 0 then
- begin
- getmem(pUser2, sizeof(pUser2^));
- Load_UserRec(PBBSWIN, pUser2, unum);
- PrintLn_Modem(PBBSWIN, 'Password = '+pUser2^.Password);
- pUser2^.Password[1] := 'N';
- Save_UserRec(PBBSWIN, pUser2, unum);
- freemem(pUser2, sizeof(pUser2^));
- end;
-
- Init_Message(PBBSWIN, 'SYSOP', 'TEST USER', 'Thanks!', 2, 0, FALSE);
- Message_Line(PBBSWIN, 'Hi Test User!');
- Message_Line(PBBSWIN, ' ... The SysOp ');
- Save_Message(PBBSWIN);
-
- Set_Node_Description(PBBSWIN, 'In PowerDLL');
- Inputs := '|WHO-ON|';
- Convert_Macros(PBBSWIN, Inputs);
-
- if Is_User_Online(PBBSWIN, 'GLEN FREY') then
- PrintLn_Modem(PBBSWIN, 'Glen is On-Line!');
-
- PrintLn_Modem(PBBSWIN, 'Number Users Online: '+int_to_asc(Number_Users_Online(PBBSWIN)));
- PrintLn_Modem(PBBSWin, 'Exiting to PowerBBS...');
- Get_Enter_Key(PBBSWIN);
- {End_Call(PBBSWIN);}
- end;
-
- exports
- PowerBBS_Main index 1;
-
- begin
- end.
-