pascal programming problem - Programmers Heaven

Howdy, Stranger!

It looks like you're new here. If you want to get involved, click one of these buttons!

Categories

Welcome to the new platform of Programmer's Heaven! We apologize for the inconvenience caused, if you visited us from a broken link of the previous version. The main reason to move to a new platform is to provide more effective and collaborative experience to you all. Please feel free to experience the new platform and use its exciting features. Contact us for any issue that you need to get clarified. We are more than happy to help you.

pascal programming problem

rrwerrwe Posts: 7Member
Please take a look: https://www.dropbox.com/sh/3r788fmlgxq14b3/n9TefWkzVD
I've tried many times but still it fails to show the statement 'Sorry! You are under 18 so cannot join this voting event.'

Also, the ID numbers that entered won't save into the text file. The voting record won't be updated if success entering the correct data.

Can anyone help me? urgent! Thanks a lot!

Comments

  • Actor21Actor21 Posts: 35Member
    How about posting your code here instead of posting a link?
  • quikcarlxquikcarlx Hollywood, FlPosts: 26Member
    You need to change your functions from the [color=Red]Result[/color] to the name of the function. I don't know how you got your
    program to compile. I changed your first function and left the rest for you to do. And I also got a copy of the program to be put on here.
    [code]program voting;

    Uses Crt;

    const
    pw = '123456';
    currentyr = 2012;

    type
    VoteType = record
    Songtitle : string[30];
    Singer : string[30];
    voted:integer;
    end;

    var
    choice1: string;
    ans: string;
    Votefile, idfile, pfile: Text;
    idno: array[1..50] of string;
    Vote: array[1..50] of VoteType;
    v, MAX_Vote, MAX_idno: Integer;

    [color=Blue]function UpperCase ( value : string ): string;

    var
    i : integer;
    temp : string;

    begin

    for i := 1 to Length( value ) do
    temp[i] := UpCase( value[i] );

    UpperCase := temp
    end;[/color]

    function TryStrToInt(Value: String; var Number: Integer): Boolean;
    var code: Integer;
    begin
    Val(Value,Number,Code);
    Result:=(Code=0);
    end;

    function FileExists(FileName: string): boolean;
    var f: File;
    begin
    {$I-}
    Assign(f,FileName);
    Reset(f);
    Close(f);
    Result:=(IOResult=0);
    {$I+}
    end;

    function OpenOrCreateDB(FileName: string): boolean;
    begin
    Result:=FileExists(FileName);
    Assign(Votefile, FileName);
    if Result then
    Reset(Votefile)
    else
    ReWrite(Votefile);
    end;

    function OpenOrCreateDB2(FileName: string): boolean;
    begin
    Result:=FileExists(FileName);
    Assign(idfile, FileName);
    if Result then
    Reset(idfile)
    else
    ReWrite(idfile);
    end;

    procedure InputID(var count2 : integer);
    begin
    if OpenOrCreateDB2('C:Dev-Passbaid.txt') then
    begin
    count2:=0;
    while not eof(idfile) do
    begin
    count2:=count2+1;
    readln(idfile, idno[count2]);
    end;
    end;
    Close(idfile);
    end;

    procedure SaveID(count2: integer);
    var
    i: integer;
    begin
    rewrite(idfile);
    for i:=1 to count2 do
    writeln(idfile,idno[i]);
    close(idfile);
    end;

    procedure InsertID(var count2 : integer);
    begin
    append(idfile);
    count2:=count2+1;
    writeln(idfile,idno[count2]);
    close(idfile);
    SaveID(Max_idno);
    end;

    procedure BubbleSortByID(var count2 : integer);
    var temp: string;
    swaps: Boolean;
    s,e,n1,n2: integer;
    begin
    e:=count2-1;
    swaps:=true;
    while (e>Low(idno)) and (swaps) do
    begin
    Swaps:=False;
    for s:=Low(idno) to e do
    begin
    TryStrToInt(copy(idno[s],2,7),n1); {convert to number, or 0 if error}
    TryStrToInt(copy(idno[s+1],2,7),n2); {convert to number, or 0 if error}
    if (ord(idno[s][1]) > ord(idno[s+1][1])) and (n1 > n2) then
    begin
    Swaps:=True;
    temp := idno[s];
    idno[s] := idno[s+1];
    idno[s+1] := temp
    end;
    end;
    e:=e-1;
    end;
    end;

    function SearchID(target:string; count:integer):Boolean;
    var
    top,bottom,middle:integer;
    found:Boolean;
    begin
    {binary search algorithm}
    BubbleSortByID(count);

    found:=false;
    count:=0;
    top:=1;
    bottom:=count;
    repeat
    middle:=(top+bottom) div 2;
    if UpperCase(target) > UpperCase(idno[middle]) then
    top := middle + 1
    else
    if UpperCase(target) < UpperCase(idno[middle]) then
    bottom := middle - 1
    else found:=true;
    until (found) or (top > bottom);
    Result := found;
    end;

    procedure InputRecord(var count : integer);
    begin
    {read all records from Votefile into Vote[] array}
    if OpenOrCreateDB('C:Dev-Passbavote.txt') then
    begin
    count:=0;
    while not EOF(Votefile) do
    begin
    count:=count+1;
    with Vote[count] do
    begin
    readln(Votefile, Songtitle);
    readln(Votefile, Singer);
    readln(Votefile, voted);
    end;
    end;
    end;
    Close(Votefile);
    end;

    procedure SaveRecord(Filename: string);
    var
    i: integer;
    begin
    Assign(Votefile, FileName);
    ReWrite(Votefile);
    for i:=1 to MAX_Vote do
    if Vote[i].Songtitle <> '$$$' then
    begin
    writeln(Votefile,Vote[i].Songtitle);
    writeln(Votefile,Vote[i].Singer);
    writeln(Votefile,Vote[i].voted);
    end;
    Close(Votefile);
    end;

    procedure DisplayRecord(count:integer);
    var
    index, align1: integer;
    begin
    ClrScr;
    writeln( 'Displaying ',MAX_Vote,' Candidates Records');
    writeln( 'Song Title Singer Vote');
    for index:=1 to count do
    with Vote[index] do
    begin
    align1:= 25-length(Songtitle);
    writeln( Songtitle, '':align1, Singer,'':6,Voted)
    end;

    writeLn( 'Press enter key to continue...');
    readln;
    end;

    procedure InsertRecord(var count: integer);
    var
    ans,tryagain:char;
    target:string;
    found:boolean;
    i,temp:integer;
    begin
    writeln('Insert Candidate Records');
    append(Votefile);
    repeat
    repeat
    write( 'Enter song title: ');
    readln(target);
    found:=false;
    i:= 0;
    while (i'') and (MAX_Vote>0) then
    begin
    i:=1;
    while (i<=MAX_Vote) and (not Result) do
    if UpperCase(Target)=UpperCase(Vote[i].Songtitle) then
    begin
    Result:=True;
    Index:=i;
    end else
    i:=i+1;
    end; {if}
    end;

    procedure VoteRecord(var count:integer);
    var
    target: string;
    index: integer;
    begin
    write('Enter the song title to be voted: ');
    readln(target);

    If LocateVoteRecord(target,index) then
    begin
    writeln('Candidate record found!');
    Vote[index].voted := Vote[index].voted + 1;
    writeln('Record updated! Thank you for your vote!')
    end else
    writeln('Candidate''s number not found!')
    end;

    procedure Printreport;
    var
    index, align1,align2,s: integer;
    swaps: Boolean;
    temp:votetype;
    pass,i:integer;
    begin
    assign(pfile,'C:Dev-Passbaprint.txt');
    rewrite(pfile);
    writeln(pfile, 'Song Title Singer Vote');
    pass:=0;
    repeat
    pass:=pass +1;
    swaps:=false;
    for i:=1 to MAX_Vote - pass do
    if vote[i].Voted < vote[i+1].Voted
    then
    begin
    temp:=Vote[i];
    Vote[i]:= Vote[i+1];
    Vote[i+1]:=temp;
    Swaps:=True;
    end;
    until (pass= MAX_vote-1) or not swaps;
    for index := 1 to MAX_Vote do
    with Vote[index] do
    begin
    align1:= 25-length(Songtitle);
    align2:= 20-length(singer);
    writeln(pfile,Songtitle, '':align1, Singer,'':align2,Voted)
    end;
    close(pfile);
    end;

    function CalcCheckData(HKID: string): Integer;
    var n: array[1..8] of Integer;
    i,j,v: Integer;
    begin
    {calculate the check data from VALID HKID}
    if Length(HKID)=8 then
    begin
    {first character, a=1..z=26}
    n[1] := Ord(UpCase(HKID[1]))-64;
    {next six must be numeric}
    for i:=2 to 7 do
    TryStrToInt(copy(HKID,i,1),n[i]);
    {last can be a=10 or number}
    if not TryStrToInt(copy(HKID,8,1),n[8]) then n[8]:=10;
    {do some math on the values}
    j:=8; v:=0;
    for i:=1 to 7 do
    begin
    v := v + (n[i]*j);
    j:=j-1;
    end;
    {calc remainder}
    Result:=(v + n[8]) mod 11;
    end;
    end;

    function HKIDValid(Format,HKID: String): boolean;
    var i,l,v: integer;
    begin
    l:=Length(HKID);
    {check length (must be same as length of format string)}
    Result:=(Length(Format)=l);
    {if valid, check characters against format string}
    if Result then
    begin
    i:=1;
    while (i<l) and (Result) do
    begin
    case Format[i] of
    '0': Result:=TryStrToInt(HKID[i],v); {0 means character must be number only (0..9)}
    'A','a': Result:=(HKID[i] in ['A'..'Z','a'..'z']); {A means character must be letter only (a..z)}
    '?': Result:=(HKID[i] in ['A'..'Z','a'..'z','0'..'9']); {? means almost any character}
    '.': Result:=(HKID[i] in ['0'..'9','A','a']); {special case}
    end; {case}
    i:=i+1;
    end; {while}
    end; {if}
    end;

    procedure ChoiceIs2;
    var idno: string;
    yr: integer;
    tryagain: char;
    finished: boolean;
    begin
    writeln('Please enter your personal information as identification.');
    writeln;
    write('Enter the year of your birth: ');
    readln(yr);
    if ((currentyr-yr) < 18) then
    writeln('Sorry! You are under 18 so cannot join this voting event. Press enter key to quit...')
    else begin
    tryagain:=#0;
    finished:=false;
    repeat
    write('Enter your HKID card [sample: A123456(3)]: ');
    readln(idno);
    if SearchID(idno, MAX_idno)
    then writeln('Sorry! You are not allowed to vote twice.')
    else if (HKIDValid('A000000.',idno)) and (CalcCheckData(idno)=0)
    then begin
    insertID(MAX_idno);
    InputRecord(MAX_Vote);
    DisplayRecord(MAX_Vote);
    VoteRecord(MAX_Vote);
    finished:=true;
    end
    else begin
    write( 'Invalid input. Do you want to try again? (Y/N): ' );
    readln(tryagain);
    end;
    until (tryagain in ['N','n']) or (SearchID(idno, MAX_idno)) or finished;
    if finished
    then writeln('Success! Press enter key to quit...');
    readln;
    end;
    end;

    procedure PasswordIsRight;
    begin
    v:=0;
    repeat
    ClrScr;
    writeln('1. Insert Records');
    writeln('2. Delete Records');
    writeln('3. Amend Records');
    writeln('4. Display Records');
    writeln('5. Print Report');
    writeln('6. Quit');
    writeln;
    write('Enter your choice (1-6):');
    readln(choice1);
    writeln;
    TryStrToInt(choice1,v);
    case v of
    1: InsertRecord(MAX_Vote);
    2: DeleteRecord(MAX_Vote);
    3: AmendRecord(MAX_Vote);
    4: DisplayRecord(MAX_Vote);
    5: Printreport;
    end;
    until v = 6;
    end;

    procedure ChoiceIs1;
    var attempts: integer;
    begin
    attempts:=0;
    repeat
    write('Please enter the password: ');
    readln(ans);
    if ans<>pw then
    begin
    writeln('Sorry! Wrong password, you have ',3-attempts,' attempts left. Please try again!');
    attempts:=attempts+1;
    end;
    until (attempts>3) or (ans=pw);

    if ans=pw then
    PasswordIsRight;
    end;

    function MainMenu: integer;
    begin
    ClrScr;
    TextColor(6);
    writeln( 'Music Voting System');
    TextColor(19);
    writeln( '[',MAX_Vote,' records found]');
    TextColor(14);
    writeln;
    TextColor(white);
    writeln( '1. Management Interface (password is needed)');
    writeln( '2. Vote ');
    writeln( '3. Quit');
    writeln;
    write('Enter your choice (1-3): ');
    readln(choice1);
    TryStrToInt(choice1,Result);
    end;

    begin
    InputRecord(MAX_Vote);
    InputID(MAX_idno);

    repeat
    v := MainMenu;

    case v of
    1: ChoiceIs1;
    2: ChoiceIs2;
    3:;
    else
    WriteLn('Invalid choice, please try again.');
    end;
    until v=3;

    SaveRecord('C:Dev-Passbavote.txt');
    end.

    [/code]
Sign In or Register to comment.