home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
CICA 1995 May
/
cica_0595_4.zip
/
cica_0595_4
/
UTIL
/
PCREDITS
/
CREDITS.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1994-06-23
|
46KB
|
1,286 lines
{$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. ---}
function long_to_asc (int: longint): string;
var
tstr: string;
begin
str(int, tstr);
long_to_asc := tstr;
end;
function asc_to_long (InString: String): longint;
var
i: integer;
value: longint;
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_long := value;
end;
Procedure PowerBBS_Main(PBBSWin: HWND); export;
var
Inputs: String;
Inputs2: String;
Counter: Byte;
Puser: pPowrUser_Record;
Puser2: pPowrUser_Record;
unum: integer;
exchange:longint;
begin
ClearScreen(PBBSWin);
PrintLn_Modem(PBBSWin, 'Welcome to the Power Exchange');
PrintLn_Modem(PBBSWin, '');
Get_UserRec(PBBSWin, pUser);
PrintLn_Modem(PBBSWin, 'You have '+long_to_asc(pUser^.credits)+' credits to spend.');
PrintLn_Modem(PBBSWin, '');
If Get_YesNoQ(PBBSWin, 'Power Union credits to another user? ',TRUE) then
begin
PrintLn_Modem(PBBSWin,'');
Print_Modem(PBBSWin, 'Enter USERNAME to send credits: ');
Ask_User(PBBSWin, Inputs, 25);
unum := Search_UserName(PBBSWin, Inputs);
if unum = 0 then
Println_Modem(PBBSWin, 'Sorry '+Inputs+' is not connected to the Power Exchange!')
else
begin
Print_Modem(PBBSWin, 'How many credits to send? ');
Ask_User(PBBSWin, Inputs2, 5);
exchange := asc_to_long(Inputs2);
if (exchange > 0) and (exchange < pUser^.Credits) then
begin
if Is_User_Online(PBBSWIN, Inputs) then
begin
PrintLn_Modem(PBBSWIN,
'Sorry, customer is in the store. Transaction cannot take place now.');
end
else
begin
getmem(pUser2, sizeof(pUser2^));
Load_UserRec(PBBSWIN, pUser2, unum);
dec(pUser^.Credits, exchange);
if pUser^.Credits < 0 then
pUser^.Credits := 0;
inc(pUser2^.Credits, exchange);
Save_UserRec(PBBSWIN, pUser2, unum);
Init_Message(PBBSWIN, 'Power Exchange', pUser2^.Name, 'Union Transaction',
1, 0, FALSE);
Message_Line(PBBSWIN, pUser^.Name+' has deposited '+long_to_asc(exchange)+
' credits in your account.');
Save_Message(PBBSWIN);
freemem(pUser2, sizeof(pUser2^));
PrintLn_Modem(PBBSWIN,'Transaction complete! Thank you.');
end;
end;
end;
end;
PrintLn_Modem(PBBSWin, 'Thank you for visiting the Power Exchange! Come again!');
Get_Enter_Key(PBBSWIN);
end;
exports
PowerBBS_Main index 1;
begin
end.