mainformunit.pas

Synchronet BBS Software是一个多用户BBS/Internet软件

    QWK_RETCTLA =(1 shl 7); 		{ Retain ctrl-a codes				}
    QWK_ATTACH	=(1 shl 8); 		{ Include file attachments 		    }
    QWK_NOINDEX =(1 shl 9); 		{ Do not create index files in QWK  }
    QWK_TZ		=(1 shl 10);		{ Include "@TZ" time zone in msgs   }
    QWK_VIA 	=(1 shl 11);		{ Include "@VIA" seen-bys in msgs   }
    QWK_NOCTRL	=(1 shl 12);		{ No extraneous control files		}

{$R *.DFM}

{ Returns total number of users in database }
function TForm1.LastUser: Integer;
var Str: AnsiString;
    f: TFileStream;
begin
    Str:=data_dir+'USER/USER.DAT';
    try
        f:=TFileStream.Create(Str,fmOpenRead or fmShareDenyNone);
        Result := f.Size div U_LEN;
        f.Free;
    except
        Result:=0;
    end;
end;

procedure SaveChanges;
begin
    if Application.MessageBox('Save Changes','User Modified',MB_YESNO)=IDYES
    then
        Form1.SaveUserExecute(Form1)
    else
        Form1.GetUserData(Form1.ScrollBar.Position);
end;

{ ************* }
{ GET USER DATA }
{ ************* }

{ Parses a single text data field }
function GetTextField(buf : PChar; maxlen : Integer): AnsiString;
var str: AnsiString;
    len: Integer;
    term: PChar;
begin
    term:=StrScan(buf,ETX);      { Look for end-of-text marker }
    if term = nil then
        len:=maxlen   { not found? }
    else
        len:=Term-buf;
    if len > maxlen then len:=maxlen;
    SetString(str,buf,len);
    Result:=str;
end;

{ Get a 16-bit decimal integer field }
function GetShortIntField(buf : PChar): AnsiString;
begin
    Result:=GetTextField(buf,5);
end;

{ Get a 32-bit decimal integer field }
function GetLongIntField(buf : PChar): AnsiString;
begin
    Result:=GetTextField(buf,10);
end;

{ Parses a flag field returning string with flag letters and spaces }
{ This function can be used for exemptions and restrictions too }
function GetFlagsField(buf : PChar): AnsiString;
var str: AnsiString;
    flagstr: AnsiString;
    flags: Integer;
    i: Integer;
begin
    str:='0x'+GetTextField(buf,8);
    flags:=StrToIntDef(str,0);
    for i:=0 to 25 do
        if flags AND (1 shl i) <> 0 then
            flagstr:=flagstr+Char(65+i)
        else
            flagstr:=flagstr+' ';
    Result:=flagstr;
end;

{ Get a hexadecimal integer field (of any size) }
function GetHexField(buf : PChar; maxlen : Integer): Integer;
var str: AnsiString;
begin
    str:='0x'+GetTextField(buf,maxlen);
    Result:=StrToIntDef(str,0);
end;

{ Convert a hexadecimal time field (in unix format) to MM/DD/YY }
function GetDateField(buf : PChar): AnsiString;
var str: AnsiString;
    date: TDateTime;
    time: Integer;
begin
    str:='0x'+GetTextField(buf,8);
    time:=StrToIntDef(str,0);
    if time=0 then begin
        Result:='00/00/00';
        Exit;
    end;
    time:=time div (24*60*60);          { convert from seconds to days }
    date:=StrToDate('1/1/1970')+time;   { convert to days since 1970 }
    Result:=FormatDateTime('mm/dd/yy',date);
end;

{ Reads a user data record to an Edit box and clears modified flag }
function GetUserText(Edit: Tedit; buf: PChar; maxlen: Integer) : AnsiString;
begin
    Edit.Text:=GetTextField(buf,maxlen);
    Edit.Tag:=0; { clear modified flag }
    Edit.MaxLength:=maxlen;
    Result:=Edit.Text;
end;

{ Reads a user data record to an Edit box and clears modified flag }
function GetUserShortInt(Edit: Tedit; buf: PChar) : AnsiString;
begin
    GetUserText(Edit,buf,5);
    Result:=Edit.Text;
end;

{ Reads a user data record to an Edit box and clears modified flag }
function GetUserLongInt(Edit: Tedit; buf: PChar) : AnsiString;
begin
    GetUserText(Edit,buf,10);
    Result:=Edit.Text;
end;

{ Reads and parses a single user record, filling in edit boxes, etc. }
procedure TForm1.GetUserData(usernumber: Integer);
var Str: AnsiString;
    f: TFileStream;
    buf: array[0..U_LEN] of Char;
begin
    { Open file and read user record }
    Str:=data_dir+'USER/USER.DAT';
    f:=TFileStream.Create(Str,fmOpenRead or fmShareDenyNone);
    f.Seek((usernumber-1)*U_LEN,soFromBeginning);
    f.Read(buf,U_LEN);
    f.Free;

    { ********************** }
    { Parse user data buffer }
    { ********************** }

    { Personal }
    GetUserText(AliasEdit,buf+U_ALIAS,LEN_ALIAS);
    GetUserText(NameEdit,buf+U_NAME,LEN_NAME);
    GetUserText(HandleEdit,buf+U_HANDLE,LEN_HANDLE);
    GetUserText(ComputerEdit,buf+U_COMP,LEN_COMP);
    GetUserText(NetMailEdit,buf+U_NETMAIL,LEN_NETMAIL);
    GetUserText(AddressEdit,buf+U_ADDRESS,LEN_ADDRESS);
    GetUserText(LocationEdit,buf+U_LOCATION,LEN_LOCATION);
    GetUserText(NoteEdit,buf+U_NOTE,LEN_NOTE);
    GetUserText(BirthDateEdit,buf+U_BIRTH,LEN_BIRTH);
    GetUserText(PasswordEdit,buf+U_PASS,LEN_PASS);
    GetUserText(ModemEdit,buf+U_MODEM,LEN_MODEM);
    GetUserText(ZipCodeEdit,buf+U_ZIPCODE,LEN_ZIPCODE);
    GetUserText(SexEdit,buf+U_SEX,1);
    GetUserText(PhoneEdit,buf+U_PHONE,LEN_PHONE);
    GetUserText(CommentEdit,buf+U_COMMENT,LEN_COMMENT);

    { Settings }
    GetUserText(RowsEdit,buf+U_ROWS,2);
    GetUserText(ShellEdit,buf+U_SHELL,8);
    GetUserText(EditorEdit,buf+U_XEDIT,8);
    GetUserText(ProtocolEdit,buf+U_PROT,1);
    GetUserText(TempFileExtEdit,buf+U_TMPEXT,3);

    { Read 'misc' bit-field }
    user_misc:=GetHexField(buf+U_MISC,8);
    ExpertCheckBox.Checked:=user_misc AND EXPERT <> 0;
    ExpertCheckBox.Tag:=0;

    TerminalCheckListBox.Checked[0]:=user_misc AND AUTOTERM <> 0;
    TerminalCheckListBox.Checked[1]:=user_misc AND NO_EXASCII = 0;
    TerminalCheckListBox.Checked[2]:=user_misc AND ANSI <> 0;
    TerminalCheckListBox.Checked[3]:=user_misc AND UCOLOR <> 0;
    TerminalCheckListBox.Checked[4]:=user_misc AND RIP <> 0;
    TerminalCheckListBox.Checked[5]:=user_misc AND WIP <> 0;
    TerminalCheckListBox.Checked[6]:=user_misc AND UPAUSE <> 0;
    TerminalCheckListBox.Checked[7]:=user_misc AND COLDKEYS = 0;
    TerminalCheckListBox.Checked[8]:=user_misc AND SPIN <> 0;
    TerminalCheckListBox.Tag:=0;

    MessageCheckListBox.Checked[0]:=user_misc AND NETMAIL <> 0;
    MessageCheckListBox.Checked[1]:=user_misc AND CLRSCRN <> 0;
    MessageCheckListBox.Tag:=0;

    FileCheckListBox.Checked[0]:=user_misc AND ANFSCAN <> 0;
    FileCheckListBox.Checked[1]:=user_misc AND EXTDESC <> 0;
    FileCheckListBox.Checked[2]:=user_misc AND BATCHFLAG <> 0;
    FileCheckListBox.Checked[3]:=user_misc AND AUTOHANG <> 0;
    FileCheckListBox.Tag:=0;

    LogonCheckListBox.Checked[0]:=user_misc AND ASK_NSCAN <> 0;
    LogonCheckListBox.Checked[1]:=user_misc AND ASK_SSCAN <> 0;
    LogonCheckListBox.Checked[2]:=user_misc AND CURSUB <> 0;
    LogonCheckListBox.Checked[3]:=user_misc AND QUIET <> 0;
    LogonCheckListBox.Checked[4]:=user_misc AND AUTOLOGON <> 0;
    LogonCheckListBox.Tag:=0;

    { Read 'QWK' bit-field }
    user_qwk:=GetHexField(buf+U_QWK,8);
    QWKCheckListBox.Checked[0]:=user_qwk AND QWK_FILES <> 0;
    QWKCheckListBox.Checked[1]:=user_qwk AND QWK_EMAIL <> 0;
    QWKCheckListBox.Checked[2]:=user_qwk AND QWK_ALLMAIL <> 0;
    QWKCheckListBox.Checked[3]:=user_qwk AND QWK_DELMAIL <> 0;
    QWKCheckListBox.Checked[4]:=user_qwk AND QWK_BYSELF <> 0;
    QWKCheckListBox.Checked[5]:=user_qwk AND QWK_EXPCTLA <> 0;
    QWKCheckListBox.Checked[6]:=user_qwk AND QWK_RETCTLA = 0;
    QWKCheckListBox.Checked[7]:=user_qwk AND QWK_ATTACH <> 0;
    QWKCheckListBox.Checked[8]:=user_qwk AND QWK_NOINDEX <> 0;
    QWKCheckListBox.Checked[9]:=user_qwk AND QWK_TZ <> 0;
    QWKCheckListBox.Checked[10]:=user_qwk AND QWK_VIA <> 0;
    QWKCheckListBox.Checked[11]:=user_qwk AND QWK_NOCTRL = 0;
    QWKCheckListBox.Tag:=0;

    { Read 'chat' bit-field }
    user_chat:=GetHexField(buf+U_CHAT,8);
    ChatCheckListBox.Checked[0]:=user_chat AND CHAT_ECHO <> 0;
    ChatCheckListBox.Checked[1]:=user_chat AND CHAT_ACTION <> 0;
    ChatCheckListBox.Checked[2]:=user_chat AND CHAT_NOPAGE = 0;
    ChatCheckListBox.Checked[3]:=user_chat AND CHAT_NOACT = 0;
    ChatCheckListBox.Checked[4]:=user_chat AND CHAT_SPLITP <> 0;
    ChatCheckListBox.Tag:=0;

    { Initialize controls based on bits set/unset }
    if user_misc AND DELETED <> 0 then
        Status.Text := 'Deleted User'
    else if user_misc AND INACTIVE <> 0 then
        Status.Text := 'Inactive User'
    else
        Status.Text := 'Active User';

    { Security }
    GetUserText(LevelEdit,buf+U_LEVEL,2);
    ExpireEdit.Text:=GetDateField(buf+U_EXPIRE);
    ExpireEdit.Tag:=0;
    Flags1Edit.Text:=GetFlagsField(buf+U_FLAGS1);
    Flags1Edit.Tag:=0;
    Flags2Edit.Text:=GetFlagsField(buf+U_FLAGS2);
    Flags2Edit.Tag:=0;
    Flags3Edit.Text:=GetFlagsField(buf+U_FLAGS3);
    Flags3Edit.Tag:=0;
    Flags4Edit.Text:=GetFlagsField(buf+U_FLAGS4);
    Flags4Edit.Tag:=0;
    ExemptionsEdit.Text:=GetFlagsField(buf+U_EXEMPT);
    ExemptionsEdit.Tag:=0;
    RestrictionsEdit.Text:=GetFlagsField(buf+U_REST);
    RestrictionsEdit.Tag:=0;
    GetUserLongInt(CreditsEdit,buf+U_CDT);
    GetUserLongInt(FreeCreditsEdit,buf+U_FREECDT);
    GetUserLongInt(MinutesEdit,buf+U_MIN);

    { Stats }
    FirstOnEdit.Text:=GetDateField(buf+U_FIRSTON);
    FirstOnEdit.Tag:=0;
    LastOnEdit.Text:=GetDateField(buf+U_LASTON);
    LastOnEdit.Tag:=0;
    GetUserShortInt(LogonsEdit,buf+U_LOGONS);
    GetUserShortInt(LogonsTodayEdit,buf+U_LTODAY);
    GetUserShortInt(TimeOnEdit,buf+U_TIMEON);
    GetUserShortInt(LastCallTimeEdit,buf+U_TLAST);
    GetUserShortInt(TimeOnTodayEdit,buf+U_TTODAY);
    GetUserShortInt(ExtraTimeEdit,buf+U_TEXTRA);
    GetUserShortInt(PostsTotalEdit,buf+U_POSTS);
    GetUserShortInt(PostsTodayEdit,buf+U_PTODAY);
    GetUserShortInt(EmailTotalEdit,buf+U_EMAILS);
    GetUserShortInt(EmailTodayEdit,buf+U_ETODAY);
    GetUserShortInt(FeedbackEdit,buf+U_FBACKS);
    GetUserShortInt(UploadedFilesEdit,buf+U_ULS);
    GetUserLongInt(UploadedBytesEdit,buf+U_ULB);
    GetUserShortInt(DownloadedFilesEdit,buf+U_DLS);
    GetUserLongInt(DownloadedBytesEdit,buf+U_DLB);
    LeechEdit.Text:=IntToStr(GetHexField(buf+U_LEECH,2));

    { etc... }

    { Extended Comment }
    Memo.Lines.Clear();
    Str:=data_dir+Format('USER/%.4d.MSG',[usernumber]);
    if FileExists(Str) then Memo.Lines.LoadFromFile(Str);
    Memo.Tag:=0;

    { Update User Number }
    NumberEdit.Text:=IntToStr(ScrollBar.Position);
    SaveUser.Enabled:=false;   { no changes have been made yet }
end;

{ ************* }
{ PUT USER DATA }
{ ************* }

{ Encodes a single text data field (of any length) }
procedure PutTextField(buf : PChar; str : AnsiString; maxlen : Integer);
var len:Integer;
    i:Integer;
begin
    for i:=0 to maxlen-1 do buf[i]:=ETX;
    len:=Length(str);
    if len > maxlen then len:=maxlen;
    for i:=0 to len-1 do buf[i]:=str[i+1];
end;

{ Encodes a flag field (A-Z) into a 32-bit Hex string }
procedure PutFlagsField(buf : PChar; str : AnsiString);
var flags: Integer;
    i:Integer;
begin
    flags:=0;
    for i:=0 to 25 do
        if Pos(Chr(65+i),str) <> 0 then
            flags:=flags OR (1 shl i);
    PutTextField(buf,IntToHex(flags,8),8);
end;

{ Converts a date string in MM/DD/YY format into a unix time_t format in hex }
procedure PutDateField(buf : PChar; str : AnsiString);
var val: Integer;
begin
    { convert to days since 1970 }
    val:=Round(StrToDate(str)-StrToDate('1/1/1970'));
    if val < 0 then val:=0;
    { convert from days to seconds }
    val:=val*(24*60*60);
    PutTextField(buf,IntToHex(val,8),8);
end;

{ Writes to a 16-bit decimal integer field }
procedure PutShortIntField(buf : PChar; str : AnsiString);
begin
    PutTextField(buf, str, 5);
end;

{ Writes to a 32-bit decimal integer field }
procedure PutLongIntField(buf : PChar; str : AnsiString);
begin
    PutTextField(buf, str, 10);
end;

{ Writes to a hexadecimal integer field (of any length) }
procedure PutHexField(buf : PChar; val : Integer; maxlen : Integer);
begin
    PutTextField(buf,IntToHex(val,maxlen),maxlen);
end;

{ Writes a user Edit box's contents to the buffer, if changed, resets Tag }
procedure PutUserText(Edit:Tedit; buf:PChar; maxlen:Integer);
begin
    if Edit.Tag = 1 then    { field modified, change record }
        PutTextField(buf,Edit.Text,maxlen);
    Edit.Tag:=0; { clear modified flag }
end;

{ Writes a flag Edit box's contents to the buffer, if changed }
{ This function can be used for exemptions and restrictions too }
procedure PutUserFlags(Edit:Tedit; buf:PChar);
begin
    if Edit.Tag = 1 then { field modified, change record }
        PutFlagsField(buf,Edit.Text);
    Edit.Tag:=0; { clear modified flag }
end;

{ Writes a 16-bit integer Edit box's contents to the buffer, if changed }
procedure PutUserShortInt(Edit:Tedit; buf:PChar);
begin
    if Edit.Tag = 1 then { field modified, change record }
        PutTextField(buf,Edit.Text,5);
    Edit.Tag:=0; { clear modified flag }