mainformunit.pas

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

end;

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

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

function SetBit(set_it: bool; field: Cardinal; bit: Cardinal): Cardinal;
begin
    if set_it then
       Result:=field OR bit    { set bit }
    else
        Result:=field AND NOT bit;  { clear bit }
end;

{ Writes a complete user record. }
procedure TForm1.PutUserData(usernumber:Integer);
var Str: AnsiString;
    f: TFileStream;
    i: Integer;
    buf: array[0..U_LEN] of Char;
begin
    if AliasEdit.Tag = 1 then begin
        { Set-up buffer for NAME.DAT record }
        PutTextField(buf,AliasEdit.Text,LEN_ALIAS);
        buf[LEN_ALIAS]:=CR;
        buf[LEN_ALIAS+1]:=LF;

        { Open NAME.DAT write user name }
        Str:=data_dir+'USER/NAME.DAT';
        if FileExists(Str) then
            f:=TFileStream.Create(Str,fmOpenWrite or fmShareExclusive)
        else
            f:=TFileStream.Create(Str,fmCreate or fmShareExclusive);
        f.Seek((usernumber-1)*(LEN_ALIAS+2),soFromBeginning);
        f.Write(buf,LEN_ALIAS+2);
        f.Free;
    end;

    { Initialize USER record buffer }
    for i:=0 to U_LEN-1 do buf[i]:=ETX;

    { Open file and read current user record }
    Str:=data_dir+'USER/USER.DAT';
    if FileExists(Str) then
        f:=TFileStream.Create(Str,fmOpenReadWrite or fmShareExclusive)
    else
        f:=TFileStream.Create(Str,fmCreate or fmShareExclusive);

    f.Seek((usernumber-1)*U_LEN,soFromBeginning);
    f.Read(buf,U_LEN);

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

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

    { Write MISC bit-field}
    if (ExpertCheckBox.Tag = 1)
        or (LogonCheckListBox.Tag = 1)
        or (TerminalCheckListBox.Tag = 1)
        or (MessageCheckListBox.Tag = 1)
        or (FileCheckListBox.Tag = 1)
        then begin
        user_misc:=SetBit(ExpertCheckBox.Checked, user_misc, EXPERT);

        { TerminalCeckListBox }
        user_misc:=SetBit(TerminalCheckListBox.Checked[0],user_misc,AUTOTERM);
        user_misc:=SetBit(NOT TerminalCheckListBox.Checked[1],user_misc,NO_EXASCII);
        user_misc:=SetBit(TerminalCheckListBox.Checked[2],user_misc,ANSI);
        user_misc:=SetBit(TerminalCheckListBox.Checked[3],user_misc,UCOLOR);
        user_misc:=SetBit(TerminalCheckListBox.Checked[4],user_misc,RIP);
        user_misc:=SetBit(TerminalCheckListBox.Checked[5],user_misc,WIP);
        user_misc:=SetBit(TerminalCheckListBox.Checked[6],user_misc,UPAUSE);
        user_misc:=SetBit(NOT TerminalCheckListBox.Checked[7],user_misc,COLDKEYS);
        user_misc:=SetBit(TerminalCheckListBox.Checked[8],user_misc,SPIN);

        { MessageCheckListBox }
        user_misc:=SetBit(MessageCheckListBox.Checked[0],user_misc,NETMAIL);
        user_misc:=SetBit(MessageCheckListBox.Checked[1],user_misc,CLRSCRN);

        { FileCheckListBox }
        user_misc:=SetBit(FileCheckListBox.Checked[0],user_misc,ANFSCAN);
        user_misc:=SetBit(FileCheckListBox.Checked[1],user_misc,EXTDESC);
        user_misc:=SetBit(FileCheckListBox.Checked[2],user_misc,BATCHFLAG);
        user_misc:=SetBit(FileCheckListBox.Checked[3],user_misc,AUTOHANG);

        { LogonCheckListBox }
        user_misc:=SetBit(LogonCheckListBox.Checked[0],user_misc,ASK_NSCAN);
        user_misc:=SetBit(LogonCheckListBox.Checked[1],user_misc,ASK_SSCAN);
        user_misc:=SetBit(LogonCheckListBox.Checked[2],user_misc,CURSUB);
        user_misc:=SetBit(LogonCheckListBox.Checked[3],user_misc,QUIET);
        user_misc:=SetBit(LogonCheckListBox.Checked[4],user_misc,AUTOLOGON);

        PutHexField(buf+U_MISC, user_misc, 8);
        end;

    if (ChatCheckListBox.Tag = 1) then begin
        user_chat:=SetBit(ChatCheckListBox.Checked[0],user_chat,CHAT_ECHO);
        user_chat:=SetBit(ChatCheckListBox.Checked[1],user_chat,CHAT_ACTION);
        user_chat:=SetBit(NOT ChatCheckListBox.Checked[2],user_chat,CHAT_NOPAGE);
        user_chat:=SetBit(NOT ChatCheckListBox.Checked[3],user_chat,CHAT_NOACT);
        user_chat:=SetBit(ChatCheckListBox.Checked[4],user_chat,CHAT_SPLITP);

        PutHexField(buf+U_CHAT, user_chat, 8);
        end;

    if (QWKCheckListBox.Tag =1) then begin
        user_qwk:=SetBit(QWKCheckListBox.Checked[0],user_qwk,QWK_FILES);
        user_qwk:=SetBit(QWKCheckListBox.Checked[1],user_qwk,QWK_EMAIL);
        user_qwk:=SetBit(QWKCheckListBox.Checked[2],user_qwk,QWK_ALLMAIL);
        user_qwk:=SetBit(QWKCheckListBox.Checked[3],user_qwk,QWK_DELMAIL);
        user_qwk:=SetBit(QWKCheckListBox.Checked[4],user_qwk,QWK_BYSELF);
        user_qwk:=SetBit(QWKCheckListBox.Checked[5],user_qwk,QWK_EXPCTLA);
        user_qwk:=SetBit(NOT QWKCheckListBox.Checked[6],user_qwk,QWK_RETCTLA);
        user_qwk:=SetBit(QWKCheckListBox.Checked[7],user_qwk,QWK_ATTACH);
        user_qwk:=SetBit(QWKCheckListBox.Checked[8],user_qwk,QWK_NOINDEX);
        user_qwk:=SetBit(QWKCheckListBox.Checked[9],user_qwk,QWK_TZ);
        user_qwk:=SetBit(QWKCheckListBox.Checked[10],user_qwk,QWK_VIA);
        user_qwk:=SetBit(NOT QWKCheckListBox.Checked[11],user_qwk,QWK_NOCTRL);

        PutHexField(buf+U_QWK, user_qwk, 8);
        end;

    { Security }
    PutUserText(LevelEdit,buf+U_LEVEL,2);
    PutUserDate(ExpireEdit,buf+U_EXPIRE);
    PutUserFlags(Flags1Edit,buf+U_FLAGS1);
    PutUserFlags(Flags2Edit,buf+U_FLAGS2);
    PutUserFlags(Flags3Edit,buf+U_FLAGS3);
    PutUserFlags(Flags4Edit,buf+U_FLAGS4);
    PutUserFlags(ExemptionsEdit,buf+U_EXEMPT);
    PutUserFlags(RestrictionsEdit,buf+U_REST);
    PutUserLongInt(CreditsEdit,buf+U_CDT);
    PutUserLongInt(FreeCreditsEdit,buf+U_FREECDT);
    PutUserLongInt(MinutesEdit,buf+U_MIN);
    { etc. }

    { Stats }
    PutUserDate(FirstOnEdit,buf+U_FIRSTON);
    PutUserDate(LastOnEdit,buf+U_LASTON);
    PutUserShortInt(LogonsEdit,buf+U_LOGONS);
    PutUserShortInt(LogonsTodayEdit,buf+U_LTODAY);
    PutUserShortInt(TimeOnEdit,buf+U_TIMEON);
    PutUserShortInt(TimeOnTodayEdit,buf+U_TTODAY);
    PutUserShortInt(LastCallTimeEdit,buf+U_TLAST);
    PutUserShortInt(ExtraTimeEdit,buf+U_TEXTRA);
    PutUserShortInt(PostsTotalEdit,buf+U_POSTS);
    PutUserShortInt(PostsTodayEdit,buf+U_PTODAY);
    PutUserShortInt(EmailTotalEdit,buf+U_EMAILS);
    PutUserShortInt(EmailTodayEdit,buf+U_ETODAY);
    PutUserShortInt(FeedbackEdit,buf+U_FBACKS);
    PutUserShortInt(UploadedFilesEdit,buf+U_ULS);
    PutUserLongInt(UploadedBytesEdit,buf+U_ULB);
    PutUserShortInt(DownloadedFilesEdit,buf+U_DLS);
    PutUserLongInt(DownloadedBytesEdit,buf+U_DLB);
    PutHexField(buf+U_LEECH, StrToInt(LeechEdit.Text), 2);
    { etc. }

    { Write user record and close file }
    f.Seek((usernumber-1)*U_LEN,soFromBeginning);
    f.Write(buf,U_LEN);
    f.Free;

    { Extended Comemnt }
    if Memo.Tag = 1 then begin
        Str:=data_dir+Format('USER/%.4d.MSG',[usernumber]);
        if Memo.Lines.Count<>0 then
            Memo.Lines.SaveToFile(Str)
        else
            DeleteFile(Str);
    end;

    SaveUser.Enabled:=false;
end;

{ ********* }
{ MAIN FORM }
{ ********* }

{ There's probably a better place to do this init stuff... constructor? }
procedure TForm1.FormShow(Sender: TObject);
begin
    data_dir:=ParamStr(1);
    if Length(data_dir)=0 then data_dir:='c:\sbbs\data\';

    users:=LastUser();
    if users = 0 then   { Create user if none exist }
        NewUserExecute(Sender);

    ScrollBar.Min:=1;
    ScrollBar.Max:=users;
    TotalStaticText.Caption:='of '+IntToStr(users);
    { *********************************** }
    { Set max lengths for edit boxes here }
    { *********************************** }
    { Personal }
    AliasEdit.MaxLength:=LEN_ALIAS;
    NameEdit.MaxLength:=LEN_NAME;
    PhoneEdit.MaxLength:=LEN_PHONE;
    HandleEdit.MaxLength:=LEN_HANDLE;
    ComputerEdit.MaxLength:=LEN_COMP;
    AddressEdit.MaxLength:=LEN_ADDRESS;
    LocationEdit.MaxLength:=LEN_LOCATION;
    ZipCodeEdit.MaxLength:=LEN_ZIPCODE;
    ModemEdit.MaxLength:=LEN_MODEM;
    CommentEdit.MaxLength:=LEN_COMMENT;
    { Security }
    PasswordEdit.MaxLength:=LEN_PASS;
    PhoneEdit.MaxLength:=LEN_PHONE;
    ModemEdit.MaxLength:=LEN_MODEM;
    SexEdit.MaxLength:=1;
    { Stats }
    { etc. }
    GetUserData(1); { Read and display in User #1 }

    PageControl.ActivePage:=PersonalTabSheet;
end;

{ Change user }
procedure TForm1.ScrollBarChange(Sender: TObject);
begin
    if SaveUser.Enabled then SaveChanges();
    users:=LastUser(); { this could change dynamically }
    ScrollBar.Max:=users;
    TotalStaticText.Caption:='of '+IntToStr(users);
    GetUserData(ScrollBar.Position);
end;

{ Better than on OnChange event, waits til users hits enter key }
procedure TForm1.NumberEditKeyPress(Sender: TObject; var Key: Char);
var val : Integer;
begin
    if Key <> #13 then Exit;
    users:=lastuser;
    val:=StrToIntDef(NumberEdit.Text,0);
    if (val = 0) or (val > users) then
        NumberEdit.Text:=IntToStr(ScrollBar.Position)
    else begin
        ScrollBar.Position:=val;
        GetUserData(val);
        Key:=#0;
    end
end;

procedure TForm1.FileExitMenuItemClick(Sender: TObject);
begin
    Close;
end;

{ OnChange event for ALL User Data Edit boxes }
procedure TForm1.EditChange(Sender: TObject);
begin
    SaveUser.Enabled:=true;
    (Sender as TComponent).Tag:=1;   { Mark as modified }
end;

{ Create a New User record }
procedure TForm1.SaveUserExecute(Sender: TObject);
begin
    PutUserData(StrToIntDef(NumberEdit.Text,ScrollBar.Position));
end;

procedure TForm1.NewUserExecute(Sender: TObject);
begin
    if SaveUser.Enabled then SaveChanges();

    { New users's number }
    users:=lastuser()+1;

    { Initialize fields to default values }
    AliasEdit.Text:='New User';
    LevelEdit.Text:='10';

    { Create the new record }
    PutUserData(users);

    { Set scroll bar and usernumber text }
    ScrollBar.Max:=users;
    ScrollBar.Position:=users;
    NumberEdit.Text:=IntToStr(users);

end;

procedure TForm1.DeleteUserExecute(Sender: TObject);
begin
    user_misc:=user_misc xor DELETED;
    LogonCheckListBox.Tag:=1;   { flag as modified }
    PutUserData(ScrollBar.Position);
    GetUserData(ScrollBar.Position);
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
    if SaveUser.Enabled then SaveChanges();
end;

procedure TForm1.DeactivateUserExecute(Sender: TObject);
begin
    user_misc:=user_misc xor INACTIVE;
    LogonCheckListBox.Tag:=1;   { flag as modified }
    PutUserData(ScrollBar.Position);
    GetUserData(ScrollBar.Position);
end;

procedure TForm1.FindButtonClick(Sender: TObject);
var Str: AnsiString;
    SearchStr: AnsiString;
    f: TFileStream;
    usernumber: Integer;
    buf: array[0..U_LEN] of Char;
begin
    SearchStr:=AnsiUpperCase(FindEdit.Text);
    usernumber:=0;
    { Open NAME.DAT write user name }
    Str:=data_dir+'USER/USER.DAT';
    if not FileExists(Str) then Exit;
    f:=TFileStream.Create(Str,fmOpenRead or fmShareDenyNone);
    if Sender = FindNextButton then
        f.Seek((ScrollBar.Position)*(U_LEN),soFromBeginning);
    while (f.Position < f.Size) and (usernumber=0) do begin
        f.Read(buf,U_LEN);
        SetString(Str,buf,U_LEN);
        Str:=AnsiUpperCase(Str);
        if Pos(SearchStr,Str) <> 0 then
            usernumber:=f.Position div (U_LEN);
        end;
    f.Free;
    if usernumber <> 0 then begin
        ScrollBar.Position:=usernumber;
        end;
end;

procedure TForm1.FindEditKeyPress(Sender: TObject; var Key: Char);
begin
    if Key = #13 then begin
        FindButtonClick(Sender);
        Key:=#0;
    end;
end;

end.