Sample Source Code for programming problems

The TextEditor class is a simple text editor.

2008-12-12T21:28:00.001-08:00

import java.awt.*;
import java.awt.event.*;
import javax.swing.*;
import java.io.*;

/**

*/

public class TextEditor extends JFrame
{
// The following are fields for the menu system.
// First, the menu bar
private JMenuBar menuBar;

// The menus
private JMenu fileMenu;
private JMenu fontMenu;

// The menu items
private JMenuItem newItem;
private JMenuItem openItem;
private JMenuItem saveItem;
private JMenuItem saveAsItem;
private JMenuItem exitItem;

// The radio button menu items
private JRadioButtonMenuItem monoItem;
private JRadioButtonMenuItem serifItem;
private JRadioButtonMenuItem sansSerifItem;

// The checkbox menu items
private JCheckBoxMenuItem italicItem;
private JCheckBoxMenuItem boldItem;

private String filename;     // To hold the file name
private JTextArea editorText;// To display the text
private final int NUM_LINES = 20;  // Lines to display
private final int NUM_CHARS = 40;  // Chars per line

/**
   Constructor
*/

public TextEditor()
{
   // Set the title.
   setTitle("Text Editor");

   // Specify what happens when the close
   // button is clicked.
   setDefaultCloseOperation(JFrame.EXIT_ON_CLOSE);

   // Create the text area.
   editorText = new JTextArea(NUM_LINES, NUM_CHARS);

   // Turn line wrapping on.
   editorText.setLineWrap(true);
   editorText.setWrapStyleWord(true);

   // Create a scroll pane and add the text area to it.
   JScrollPane scrollPane = new JScrollPane(editorText);

   // Add the scroll pane to the content pane.
   add(scrollPane);

   // Build the menu bar.
   buildMenuBar();

   // Pack and display the window.
   pack();
   setVisible(true);
}

/**
   The buildMenuBar method creates a menu bar and
   calls the createFileMenu method to create the
   file menu.
*/

private void buildMenuBar()
{
   // Build the file and font menus.
   buildFileMenu();
   buildFontMenu();

   // Create the menu bar.
   menuBar = new JMenuBar();

   // Add the file and font menus to the menu bar.
   menuBar.add(fileMenu);
   menuBar.add(fontMenu);

   // Set the menu bar for this frame.
   setJMenuBar(menuBar);
}

/**
   The buildFileMenu method creates the file menu
   and populates it with its menu items.
*/

private void buildFileMenu()
{
   // Create the New menu item.
   newItem = new JMenuItem("New");
   newItem.setMnemonic(KeyEvent.VK_N);
   newItem.addActionListener(new NewListener());

   // Create the Open menu item.
   openItem = new JMenuItem("Open");
   openItem.setMnemonic(KeyEvent.VK_O);
   openItem.addActionListener(new OpenListener());

   // Create the Save menu item.
   saveItem = new JMenuItem("Save");
   saveItem.setMnemonic(KeyEvent.VK_S);
   saveItem.addActionListener(new SaveListener());

   // Create the Save As menu item.
   saveAsItem = new JMenuItem("Save As");
   saveAsItem.setMnemonic(KeyEvent.VK_A);
   saveAsItem.addActionListener(new SaveListener());

   // Create the Exit menu item.
   exitItem = new JMenuItem("Exit");
   exitItem.setMnemonic(KeyEvent.VK_X);
   exitItem.addActionListener(new ExitListener());

   // Create a menu for the items we just created.
   fileMenu = new JMenu("File");
   fileMenu.setMnemonic(KeyEvent.VK_F);

   // Add the items and some separator bars to the menu.
   fileMenu.add(newItem);
   fileMenu.add(openItem);
   fileMenu.addSeparator();// Separator bar
   fileMenu.add(saveItem);
   fileMenu.add(saveAsItem);
   fileMenu.addSeparator();// Separator bar
   fileMenu.add(exitItem);
}

/**
   The buildFontMenu method creates the font menu
      and populates it with its menu items.
*/

private void buildFontMenu()
{
   // Create the Monospaced menu item.
   monoItem = new JRadioButtonMenuItem("Monospaced");
   monoItem.addActionListener(new FontListener());

   // Create the Serif menu item.
   serifItem = new JRadioButtonMenuItem("Serif");
   serifItem.addActionListener(new FontListener());

   // Create the SansSerif menu item.
   sansSerifItem =
           new JRadioButtonMenuItem("SansSerif", true);
   sansSerifItem.addActionListener(new FontListener());

   // Group the radio button menu items.
   ButtonGroup group = new ButtonGroup();
   group.add(monoItem);
   group.add(serifItem);
   group.add(sansSerifItem);

   // Create the Italic menu item.
   italicItem = new JCheckBoxMenuItem("Italic");
   italicItem.addActionListener(new FontListener());

   // Create the Bold menu item.
   boldItem = new JCheckBoxMenuItem("Bold");
   boldItem.addActionListener(new FontListener());

   // Create a menu for the items we just created.
   fontMenu = new JMenu("Font");
   fontMenu.setMnemonic(KeyEvent.VK_T);

   // Add the items and some separator bars to the menu.
   fontMenu.add(monoItem);
   fontMenu.add(serifItem);
   fontMenu.add(sansSerifItem);
   fontMenu.addSeparator();// Separator bar
   fontMenu.add(italicItem);
   fontMenu.add(boldItem);
}

/**
   Private inner class that handles the event that
   is generated when the user selects New from
   the file menu.
*/

private class NewListener implements ActionListener
{
   public void actionPerformed(ActionEvent e)
   {
      editorText.setText("");
      filename = null;
   }
}

/**
   Private inner class that handles the event that
   is generated when the user selects Open from
   the file menu.
*/

private class OpenListener implements ActionListener
{
   public void actionPerformed(ActionEvent e)
   {
      int chooserStatus;

      JFileChooser chooser = new JFileChooser();
      chooserStatus = chooser.showOpenDialog(null);
      if (chooserStatus == JFileChooser.APPROVE_OPTION)
      {
         // Get a reference to the selected file.
         File selectedFile = chooser.getSelectedFile();

         // Get the path of the selected file.
         filename = selectedFile.getPath();

         // Open the file.
         if (!openFile(filename))
         {
            JOptionPane.showMessageDialog(null,
                             "Error reading " +
                             filename, "Error",
                             JOptionPane.ERROR_MESSAGE);
         }
      }
   }

   /**
      The openFile method opens the file specified by
      filename and reads its contents into the text
      area. The method returns true if the file was
      opened and read successfully, or false if an
      error occurred.
      @param filename The name of the file to open.
   */

   private boolean openFile(String filename)
   {
      boolean success;
      String inputLine, editorString = "";
      FileReader freader;
      BufferedReader inputFile;

      try
      {
         // Open the file.
         freader = new FileReader(filename);
         inputFile = new BufferedReader(freader);

         // Read the file contents into the editor.
         inputLine = inputFile.readLine();
         while (inputLine != null)
         {
            editorString = editorString +
                           inputLine + "\n";
            inputLine = inputFile.readLine();
         }
         editorText.setText(editorString);

         // Close the file.
         inputFile.close();

         // Indicate that everything went OK.
         success = true;
      }
      catch (IOException e)
      {
         // Something went wrong.
         success = false;
      }

      // Return our status.
      return success;
   }
}

/**
   Private inner class that handles the event that
   is generated when the user selects Save or Save
   As from the file menu.
*/

private class SaveListener implements ActionListener
{
   public void actionPerformed(ActionEvent e)
   {
      int chooserStatus;

      // If the user selected Save As, or the contents
      // of the editor have not been saved, use a file
      // chooser to get the file name. Otherwise, save
      // the file under the current file name.

      if (e.getActionCommand() == "Save As" ||
          filename == null)
      {
         JFileChooser chooser = new JFileChooser();
         chooserStatus = chooser.showSaveDialog(null);
         if (chooserStatus == JFileChooser.APPROVE_OPTION)
         {
            // Get a reference to the selected file.
            File selectedFile =
                          chooser.getSelectedFile();

            // Get the path of the selected file.
            filename = selectedFile.getPath();
         }
      }

      // Save the file.
      if (!saveFile(filename))
      {
         JOptionPane.showMessageDialog(null,
                            "Error saving " +
                            filename,
                            "Error",
                            JOptionPane.ERROR_MESSAGE);
      }
   }

   /**
      The saveFile method saves the contents of the
      text area to a file. The method returns true if
      the file was saved successfully, or false if an
      error occurred.
      @param filename The name of the file.
      @return true if successful, false otherwise.
   */

   private boolean saveFile(String filename)
   {
      boolean success;
      String editorString;
      FileWriter fwriter;
      PrintWriter outputFile;

      try
      {
         // Open the file.
         fwriter = new FileWriter(filename);
         outputFile = new PrintWriter(fwriter);

         // Write the contents of the text area
         // to the file.
         editorString = editorText.getText();
         outputFile.print(editorString);

         // Close the file.
         outputFile.close();

         // Indicate that everything went OK.
         success = true;
      }
      catch (IOException e)
      {
         // Something went wrong.
          success = false;
      }

      // Return our status.
      return success;
   }
}

/**
   Private inner class that handles the event that
   is generated when the user selects Exit from
   the file menu.
*/

private class ExitListener implements ActionListener
{
   public void actionPerformed(ActionEvent e)
   {
      System.exit(0);
   }
}

/**
   Private inner class that handles the event that
   is generated when the user selects an item from
   the font menu.
*/

private class FontListener implements ActionListener
{
   public void actionPerformed(ActionEvent e)
   {
      // Get the current font.
      Font textFont = editorText.getFont();

      // Retrieve the font name and size.
      String fontName = textFont.getName();
      int fontSize = textFont.getSize();

      // Start with plain style.
      int fontStyle = Font.PLAIN;

      // Determine which font is selected.
      if (monoItem.isSelected())
         fontName = "Monospaced";
      else if (serifItem.isSelected())
         fontName = "Serif";
      else if (sansSerifItem.isSelected())
         fontName = "SansSerif";

      // Determine whether italic is selected.
      if (italicItem.isSelected())
         fontStyle += Font.ITALIC;

      // Determine whether bold is selected.
      if (boldItem.isSelected())
         fontStyle += Font.BOLD;

      // Set the font as selected.
      editorText.setFont(new Font(fontName,
                             fontStyle, fontSize));
   }
}

/**
   main method
*/

public static void main(String[] args)
{
   TextEditor te = new TextEditor();
}
}

Header File and Library Function Reference

2008-12-11T07:37:00.000-08:00

This appendix provides a reference for the C++ library functions discussed in the book.
The following table gives an alphabetical list of functions. Tables of functions that are
organized by their header files follow it.
Table I-1 Alphabetical Listing of Selected Library Functions
Function Details
abs(m)
Header File:
cmath
Description:
Accepts an integer argument. Returns the absolute value of the argument
as an integer.
Example:
a = abs(m);
atof(str)
Header File:
cstdlib
Description:
Accepts a C-string as an argument. The function converts the string to a
double
and returns that value.
Example:
num = atof("3.14159");
atoi(str)
Header File:
cstdlib
Description:
Accepts a C-string as an argument. The function converts the string to an
int
and returns that value.
Example:
num = atoi("4569");
atol(str)
Header File:
cstdlib
Description:
Accepts a C-string as an argument. The function converts the string to a
long
and returns that value.
Example:
num = atol("5000000");
2
Appendix I: Header File and Library Function Reference
cos(m)
Header File:
cmath
Description:
Accepts a
double
argument. Returns the cosine of the argument. The
argument should be an angle expressed in radians. The return type is
double
.
Example:
a = cos(m);
exit(status)
Header File:
cstdlib
Description:
Accepts an
int
argument. Terminates the program and passes the value
of the argument to the operating system.
Example:
exit(0);
exp(m)
Header File:
cmath
Description:
Accepts a
double
argument. Computes the exponential function of the
argument, which is e
x
. The return type is
double
.
Example:
a = exp(m);
fmod(m, n)
Header File:
cmath
Description:
Accepts two
double
arguments. Returns, as a
double
, the remainder of
the first argument divided by the second argument. Works like the
modulus operator, but the arguments are doubles. (The modulus operator
only works with integers.) Take care not to pass zero as the second
argument. Doing so would cause division by zero.
Example:
a = fmod(m, n);
isalnum(ch)
Header File:
cctype
Description:
Accepts a
char
argument. Returns true if the argument is a letter of the
alphabet or a digit. Otherwise, it returns false.
Example:
if (isalnum(ch))
cout << ch << " is alphanumeric.\n";
isdigit(ch)
Header File:
cctype
Description:
Accepts a
char
argument. Returns true if the argument is a digit 0 - 9.
Otherwise, it returns false.
Example:
if (isdigit(ch))
cout << ch << " is a digit.\n";
Table I-1 Alphabetical Listing of Selected Library Functions
(continued)
Function Details
Appendix I: Header File and Library Function Reference
3
islower(ch)
Header File:
cctype
Description:
Accepts a
char
argument. Returns true if the argument is a lowercase
letter. Otherwise, it returns false.
Example:
if (islower(ch))
cout << ch << " is lowercase.\n";
isprint(ch)
Header File:
cctype
Description:
Accepts a
char
argument. Returns true if the argument is a printable
character (including a space). Returns false otherwise.
Example:
if (isprint(ch))
cout << ch << " is printable.\n";
ispunct(ch)
Header File:
cctype
Description:
Accepts a
char
argument. Returns true if the argument is a printable
character other than a digit, letter, or space. Returns false otherwise.
Example:
if (ispunct(ch))
cout << ch << " is punctuation.\n";
isspace(ch)
Header File:
cctype
Description:
Accepts a
char
argument. Returns true if the argument is a whitespace
character. Whitespace characters are any of the following:
• space................ ‘ ’
• newline.............. ‘\n’
• tab.................. ‘\t’
• vertical tab......... ‘\v’
Otherwise, it returns false.
Example:
if (isspace(ch))
cout << ch << " is whitespace.\n";
isupper(ch)
Header File:
cctype
Description:
Accepts a
char
argument. Returns true if the argument is an uppercase
letter. Otherwise, it returns false.
Example:
if (isupper(ch))
cout << ch << " is uppercase.\n";
log(m)
Header File:
cmath
Description:
Accepts a
double
argument. Returns, as a
double
, the natural logarithm
of the argument.
Example:
a = log(m);
Table I-1 Alphabetical Listing of Selected Library Functions
(continued)
Function Details
4
Appendix I: Header File and Library Function Reference
log10(m)
Header File:
cmath
Description:
Accepts a double argument. Returns, as a double, the base-10 logarithm
of the argument.
Example:
a = log10(m);
pow(m, n) Header File: cmath
Description:
Accepts two double arguments. Returns the value of argument 1 raised
to the power of argument 2.
Example:
a = pow(m, n);
rand() Header File: cstdlib
Description:
Generates a pseudorandom number.
Example:
x = rand();
sin(m) Header File: cmath
Description:
Accepts a double argument. Returns, as a double, the sine of the
argument. The argument should be an angle expressed in radians.
Example:
a = sin(m);
sqrt(m) Header File: cmath
Description:
Accepts a double argument. Returns, as a double, the square root of the
argument.
Example:
a = sqrt(m);
srand(m) Header File: cstdlib
Description:
Accepts an unsigned int argument. The argument is used as a seed
value to randomize the results of the rand() function.
Example:
srand(m);
strcat(str1, str2) Header File: cstring
Description:
Accepts two C-strings as arguments. The function appends the contents
of the second string to the first string. (The first string is altered; the
second string is left unchanged.)
Example:
strcat(string1, string2);
Table I-1 Alphabetical Listing of Selected Library Functions (continued)
Function Details
Appendix I: Header File and Library Function Reference 5
strcmp(str1, str2) Header File: cstring
Description:
Accepts pointers to two string arguments. If string1 and string2 are the
same, this function returns 0. If string2 is alphabetically greater than
string1, it returns a positive number. If string2 is alphabetically less than
string1, it returns a negative number.
Example:
if (strcmp(string1, string2) == 0)
cout << "The strings are equal.\n";
strcpy(str1, str2) Header File: cstring
Description:
Accepts two C-strings as arguments. The function copies the second
string to the first string. The second string is left unchanged.
Example:
strcpy(string1, string2);
strlen(str) Header File: cstring
Description:
Accepts a C-string as an argument. Returns the length of the string (not
including the null terminator).
Example:
len = strlen(name);
strncpy(str1, str2, n) Header File: cstring
Description:
Accepts two C-strings and an integer argument. The third argument, an
integer, indicates how many characters to copy from the second string to
the first string. If string2 has fewer than n characters, string1 is padded
with ‘\0’ characters.
Example:
strncpy(string1, string2, n);
strstr(str1, str2) Header File: cstring
Description:
Searches for the first occurrence of string2 in string1. If an occurrence of
string2 is found, the function returns a pointer to it. Otherwise, it returns
a NULL pointer (address 0).
Example:
cout << strstr(string1, string2);
tan(m) Header File: cmath
Description:
Accepts a double argument. Returns, as a double, the tangent of the
argument. The argument should be an angle expressed in radians.
Example:
a = tan(m);
Table I-1 Alphabetical Listing of Selected Library Functions (continued)
Function Details
6 Appendix I: Header File and Library Function Reference
tolower(ch) Header File: cctype
Description:
Accepts a char argument. Returns the lowercase equivalent of its
argument.
Example:
ch = tolower(ch);
toupper(ch) Header File: cctype
Description:
Accepts a char argument. Returns the uppercase equivalent of its
argument.
Example:
ch = toupper(ch);
Table I-2 Selected cstdlib functions
Function Details
atof(str) Header File: cstdlib
Description:
Accepts a C-string as an argument. The function converts the string to a
double and returns that value.
Example:
num = atof("3.14159");
atoi(str) Header File: cstdlib
Description:
Accepts a C-string as an argument. The function converts the string to an
int and returns that value.
Example:
num = atoi("4569");
atol(str) Header File: cstdlib
Description:
Accepts a C-string as an argument. The function converts the string to a
long and returns that value.
Example:
num = atol("5000000");
exit(status) Header File: cstdlib
Description:
Accepts an int argument. Terminates the program and passes the value
of the argument to the operating system.
Example:
exit(0);
Table I-1 Alphabetical Listing of Selected Library Functions (continued)
Function Details
Appendix I: Header File and Library Function Reference 7
rand() Header File: cstdlib
Description:
Generates a pseudorandom number.
Example:
x = rand();
srand(m) Header File: cstdlib
Description:
Accepts an unsigned int argument. The argument is used as a seed
value to randomize the results of the rand() function.
Example:
srand(m);
Table I-3 Selected cmath Functions
Function Details
abs(m) Header File: cmath
Description:
Accepts an integer argument. Returns the absolute value of the argument
as an integer.
Example:
a = abs(m);
cos(m) Header File: cmath
Description:
Accepts a double argument. Returns the cosine of the argument. The
argument should be an angle expressed in radians. The return type is
double.
Example:
a = cos(m);
exp(m) Header File: cmath
Description:
Accepts a double argument. Computes the exponential function of the
argument, which is ex. The return type is double.
Example:
a = exp(m);
fmod(m, n) Header File: cmath
Description:
Accepts two double arguments. Returns, as a double, the remainder of
the first argument divided by the second argument. Works like the
modulus operator, but the arguments are doubles. (The modulus operator
only works with integers.) Take care not to pass zero as the second
argument. Doing so would cause division by zero.
Example:
a = fmod(m, n);
Table I-2 Selected cstdlib functions (continued)
Function Details
8 Appendix I: Header File and Library Function Reference
log(m) Header File: cmath
Description:
Accepts a double argument. Returns, as a double, the natural logarithm
of the argument.
Example:
a = log(m);
log10(m) Header File: cmath
Description:
Accepts a double argument. Returns, as a double, the base-10 logarithm
of the argument.
Example:
a = log10(m);
pow(m, n) Header File: cmath
Description:
Accepts two double arguments. Returns the value of argument 1 raised
to the power of argument 2.
Example:
a = pow(m, n);
sin(m) Header File: cmath
Description:
Accepts a double argument. Returns, as a double, the sine of the
argument. The argument should be an angle expressed in radians.
Example:
a = sin(m);
sqrt(m) Header File: cmath
Description:
Accepts a double argument. Returns, as a double, the square root of the
argument.
Example:
a = sqrt(m);
tan(m) Header File: cmath
Description:
Accepts a double argument. Returns, as a double, the tangent of the
argument. The argument should be an angle expressed in radians.
Example:
a = tan(m);
Table I-3 Selected cmath Functions (continued)
Function Details
Appendix I: Header File and Library Function Reference 9
Table I-4 Selected cstring Functions
Function Details
strcat(str1, str2) Header File: cstring
Description:
Accepts two C-strings as arguments. The function appends the contents
of the second string to the first string. (The first string is altered; the
second string is left unchanged.)
Example:
strcat(string1, string2);
strcmp(str1, str2) Header File: cstring
Description:
Accepts pointers to two string arguments. If string1 and string2 are the
same, this function returns 0. If string2 is alphabetically greater than
string1, it returns a positive number. If string2 is alphabetically less than
string1, it returns a negative number.
Example:
if (strcmp(string1, string2) == 0)
cout << "The strings are equal.\n";
strcpy(str1, str2) Header File: cstring
Description:
Accepts two C-strings as arguments. The function copies the second
string to the first string. The second string is left unchanged.
Example:
strcpy(string1, string2);
strlen(str) Header File: cstring
Description:
Accepts a C-string as an argument. Returns the length of the string (not
including the null terminator)
Example:
len = strlen(name);
strncpy(str1, str2, n) Header File: cstring
Description:
Accepts two C-strings and an integer argument. The third argument, an
integer, indicates how many characters to copy from the second string to
the first string. If string2 has fewer than n characters, string1 is padded
with ‘\0’ characters.
Example:
strncpy(string1, string2, n);
strstr(str1, str2) Header File: cstring
Description:
Searches for the first occurrence of string2 in string1. If an occurrence of
string2 is found, the function returns a pointer to it. Otherwise, it returns
a NULL pointer (address 0).
Example:
cout << strstr(string1, string2);
10 Appendix I: Header File and Library Function Reference
Table I-5 Selected cctype Functions
Function Details
isalnum(ch) Header File: cctype
Description:
Accepts a char argument. Returns true if the argument is a letter of the
alphabet or a digit. Otherwise, it returns false.
Example:
if (isalnum(ch))
cout << ch << " is alphanumeric.\n";
isdigit(ch) Header File: cctype
Description:
Accepts a char argument. Returns true if the argument is a digit 0 - 9.
Otherwise, it returns false.
Example:
if (isdigit(ch))
cout << ch << " is a digit.\n";
islower(ch) Header File: cctype
Description:
Accepts a char argument. Returns true if the argument is a lowercase
letter. Otherwise, it returns false.
Example:
if (islower(ch))
cout << ch << " is lowercase.\n";
isprint(ch) Header File: cctype
Description:
Accepts a char argument. Returns true if the argument is a printable
character (including a space). Returns false otherwise.
Example:
if (isprint(ch))
cout << ch << " is printable.\n";
ispunct(ch) Header File: cctype
Description:
Accepts a char argument. Returns true if the argument is a printable
character other than a digit, letter, or space. Returns false otherwise.
Example:
if (ispunct(ch))
cout << ch << " is punctuation.\n";
isspace(ch) Header File: cctype
Description:
Accepts a char argument. Returns true if the argument is a whitespace
character. Whitespace characters are any of the following:
• space................ ‘ ’
• newline.............. ‘\n’
• tab.................. ‘\t’
• vertical tab......... ‘\v’
Otherwise, it returns false.
Example:
if (isspace(ch))
cout << ch << " is whitespace.\n";
Appendix I: Header File and Library Function Reference 11
isupper(ch) Header File: cctype
Description:
Accepts a char argument. Returns true if the argument is an uppercase
letter. Otherwise, it returns false.
Example:
if (isupper(ch))
cout << ch << " is uppercase.\n";
tolower(ch) Header File: cctype
Description:
Accepts a char argument. Returns the lowercase equivalent of its
argument.
Example:
ch = tolower(ch);
toupper(ch) Header File: cctype
Description:
Accepts a char argument. Returns the uppercase equivalent of its
argument.
Example:
ch = toupper(ch);
Table I-5 Selected cctype Functions (continued)
Function Details

Program code for Ada, 4th Edition

2008-12-11T07:10:00.001-08:00

Chapter 2 Ada Concepts
2.2 Overall structure
with Sqrt, Simple_IO;
procedure Print_Root is
use Simple_IO;
begin
Put(Sqrt(2.5));
end Print_Root;
----
with Sqrt, Simple_IO;
procedure Print_Root is
use Simple_IO;
X: Float;
begin
Get(X);
Put(Sqrt(X));
end Print_Root;
----
with Sqrt, Simple_IO;
procedure Print_Roots is
use Simple_IO;
X: Float;
begin
Put("Roots of various numbers");
New_Line(2);
loop
Get(X);
exit when X = 0.0;
Put(" Root of ");
Put(X);
Put(" is ");
if X < 0.0 then
Put("not calculable");
else
Put(Sqrt(X));
end if;
New_Line;
end loop;
New_Line;
Put("Program finished");
New_Line;
end Print_Roots;
----
function Sqrt(F: Float) return Float is
R: Float;
begin
-- compute value of Sqrt(F) in R
return R;
end Sqrt;
----
package Simple_IO is
procedure Get(F: out Float);
procedure Put(F: in Float);
procedure Put(S: in String);
procedure New_Line(N: in Integer := 1);
end Simple_IO;
----
with Text_IO;
package body Simple_IO is
...
procedure Get(F: out Float) is
...
begin
...
end Get;
-- other procedures similarly
end Simple_IO;
2.3 Errors and exceptions
if X < 0.0 then
Put("not calculable");
else
Put(Sqrt(X));
end if;
----
begin
Put(Sqrt(X));
exception
when Constraint_Error =>
Put("not calculable");
end;
2.4 The type model
declare
type Colour is (Red, Amber, Green);
type Fish is (Cod, Hake, Plaice);
X, Y: Colour;
A, B: Fish;
begin
X := Red; -- ok
A := Hake; -- ok
B := X; -- illegal
...
end;
----
declare
type Light is new Colour;
C: Colour;
L: Light;
begin
L := Amber; -- the light amber, not the colour
C := Colour(L); -- explicit conversion
...
end;
2.5 Generics
generic
type Num is digits <>;
package Float_IO is
...
procedure Get(Item: out Num; ... );
procedure Put(Item: in Num; ... );
...
end Float_IO;
----
with Elementary_Functions_Exceptions;
generic
type Float_Type is digits <>;
package Generic_Elementary_Functions is
function Sqrt(X: Float_Type) return Float_Type;
... -- and so on
end;
2.6 Input-output
with IO_Exceptions;
package Text_IO is
type Count is ... -- an integer type
...
procedure New_Line(Spacing: in Count := 1);
procedure Set_Col(To: in Count);
function Col return Count;
...
procedure Get(Item: out Character);
procedure Put(Item: in Character);
procedure Put(Item: in String);
...
-- the package Float_IO outlined in the previous section
-- plus a similar package Integer_IO
...
end Text_IO;
----
C: Character;
...
Put("Do you want to stop? Answer Y if so. ");
Get(C);
if C = 'Y' then
...
2.7 Running a program
with Text_IO, Generic_Elementary_Functions;
procedure Print_Roots is
type Real is digits 7;
X: Real;
use Text_IO;
package Real_IO is new Float_IO(Real);
use Real_IO;
package Real_Maths is
new Generic_Elementary_Functions(Real);
use Real_Maths;
begin
Put("Roots of various numbers");
...
... -- and so on as before
...
end Print_Roots;
----
with Text_IO, Generic_Elementary_Functions;
package Etc is
type Real is digits 7;
package Real_IO is new Text_IO.Float_IO(Real);
package Int_IO is new Text_IO.Integer_IO(Integer);
package Real_Maths is
new Generic_Elementary_Functions(Real);
end Etc;
----
with Text_IO, Etc;
use Text_IO, Etc;
procedure Program is
use Real_IO, Int_IO, Real_Maths; -- as required
...
...
end Program;
Chapter 4 Scalar Types
4.2 Blocks and scopes
declare
I: Integer := 0; -- declarations here
begin
I := I+1; -- statements here
end;
----
declare
I, J: Integer;
begin
... -- here I is the outer one
declare
I: Integer;
begin
... -- here I is the inner one
end;
... -- here I is the outer one
end;
----
declare
I: Integer := 0;
begin
...
declare
K: Integer := I;
I: Integer := 0;
begin
...
end;
...
end;
Exercise 4.2
declare
I: Integer := 7;
J, K: Integer
begin
J := I+K;
declare
P: Integer=I;
I, J: Integer;
begin
I := P+Q;
J := P-Q;
K := I*J;
end;
Put(K); -- output value of K
end;
4.6 Enumeration types
type Colour is (Red, Amber, Green);
type Day is (Mon, Tue, Wed, Thu, Fri, Sat, Sun);
type Stone is (Amber, Beryl, Quartz);
type Groom is (Tinker, Tailor, Soldier, Sailor,
Rich_Man, Poor_Man, Beggar_Man, Thief);
type Solo is (Alone);
Chapter 5 Control Structures
5.1 If statements
if Hungry then
Cook;
Eat;
Wash_Up;
end if;
----
if Today = Sun then
Tomorrow := Mon;
else
Tomorrow := Day'Succ(Today);
end if;
----
if A = 0.0 then
-- linear case
else
if B**2 - 4.0*A*C >= 0.0 then
-- real roots
else
-- complex roots
end if;
end if;
----
if A = 0.0 then
-- linear case
elsif B**2 - 4.0*A*C >= 0.0 then
-- real roots
else
-- complex roots
end if;
----
if Order = Left then
Turn_Left;
else
if Order = Right then
Turn_Right;
else
if Order = Back then
Turn_Back;
end if;
end if;
end if;
----
if Order = Left then
Turn_Left;
elsif Order = Right then
Turn_Right;
elsif Order = Back then
Turn_Back;
end if;
5.2 Case statements
case Order is
when Left => Turn_Left;
when Right => Turn_Right;
when Back => Turn_Back;
when On => null;
end case;
----
case Today is
when Mon Tues Wed Thu => Work;
when Fri => Work; Party;
when Sat Sun => null;
end case;
----
case Today is
when Mon .. Thu => Work;
when Fri => Work; Party;
when others => null;
end case;
----
case Today is
when Weekday => Work;
if Today = Fri then
Party;
end if;
when others => null;
end case;
----
case Weekday'(Today) is
when Mon .. Thu => Work;
when Fri => Work; Party;
end case;
5.3 Loop statements
loop
Work;
Eat;
Sleep;
end loop;
----
declare
E: Real := 1.0;
I: Integer := 0;
Term: Real := 1.0;
begin
loop
I := I + 1;
Term := Term / Real(I);
E := E + Term;
end loop;
...
----
loop
if I = N then exit; end if;
I := I + 1;
Term := Term / Real(I);
E := E + Term;
end loop;
----
loop
exit when I = N;
I := I + 1;
Term := Term / Real(I);
E := E + Term;
end loop;
----
while I /= N loop
I := I + 1;
Term := Term / Real(I);
E := E + Term;
end loop;
----
for I in 1 .. N loop
Term := Term / Real(I);
E := E + Term;
end loop;
----
for I in 1 .. N loop
for J in 1 .. M loop
-- if values of I and J satisfy
-- some condition then leave nested loop
end loop;
end loop;
----
Search:
for I in 1 .. N loop
for J in 1 .. M loop
if condition_OK then
I_Value := I;
J_Value := J;
exit Search;
end if;
end loop;
end loop Search;
-- control passes here
Chapter 6 Composite Types
6.1 Arrays
for I in A'Range loop
A(I) := 0.0;
end loop;
for I in AA'Range(1) loop
for J in AA'Range(2) loop
AA(I, J) := 0.0;
end loop;
end loop;
6.3 Array aggregates
type Event is (Birth, Accession, Death);
type Monarch is (William_I, William_II, Henry_I, ... ,
Victoria, Edward_VII, George_V, ... );
...
Royal_Events: constant array (Monarch, Event) of Integer
:= (William_I => (1027, 1066, 1087),
William_II => (1056, 1087, 1100),
Henry_I => (1068, 1100, 1135),
...
Victoria => (1819, 1837, 1901),
Edward_VII => (1841, 1901, 1910),
George_V => (1865, 1910, 1936),
... );
6.5 Arrays of arrays and slices
Zoo: constant String_Array := ("aardvark",
"baboon ",
"camel ",
"dolphin ",
"elephant",
...
"zebra ");
6.6 One-dimensional array operations
White: constant Colour := (F, F, F);
Red: constant Colour := (T, F, F);
Yellow: constant Colour := (F, T, F);
Blue: constant Colour := (F, F, T);
Green: constant Colour := (F, T, T);
Purple: constant Colour := (T, F, T);
Orange: constant Colour := (T, T, F);
Black: constant Colour := (T, T, T);
6.7 Records
type Month_Name is (Jan, Feb, Mar, Apr, May, Jun, Jul,
Aug, Sep, Oct, Nov, Dec);
type Date is
record
Day: Integer range 1 .. 31;
Month: Month_Name;
Year: Integer;
end record;
Chapter 7 Subprograms
7.1 Functions
function Sqrt(X: Real) return Real is
R: Real;
begin
-- compute value of Sqrt(X) in R
return R;
end Sqrt;
----
function Sign(X: Integer) return Integer is
begin
if X > 0 then
return +1;
elsif X < 0 then
return -1;
else
return 0;
end if;
end Sign;
----
function Factorial(N: Positive) return Positive is
begin
if N = 1 then
return 1;
else
return N * Factorial(N-1);
end if;
end Factorial;
----
function Sum(A: Vector) return Real is
Result: Real := 0.0;
begin
for I in A'Range loop
Result := Result + A(I);
end loop;
return Result;
end Sum;
----
function Inner(A, B: Vector) return Real is
Result: Real := 0.0;
begin
for I in A'Range loop
Result := Result + A(I)*B(I);
end loop;
return Result;
end Inner;
----
function Rev(X: Vector) return Vector is
R: Vector(X'Range);
begin
for I in X'Range loop
R(I) := X(X'First+X'Last-I);
end loop;
return R;
end Rev;
7.2 Operators
function "*" (A, B: Vector) return Real is
Result: Real := 0.0;
begin
for I in A'Range loop
Result := Result + A(I)*B(I);
end loop;
return Result;
end "*";
----
function "+" (A: Vector) return Real is
Result: Real := 0.0;
begin
for I in A'Range loop
Result := Result + A(I);
end loop;
return Result;
end "+";
7.3 Procedures
declare
A: constant Integer := 2+P; -- in
B: constant Integer := 37; -- in
C: Integer; -- out
begin
C := A+B; -- body
Q := C; -- out
end;
----
declare
X: Integer := I;
begin
X := X+1;
I := X;
end;
----
I: Integer;
A: array (1 .. 10) of Integer;
procedure Silly(X: in out Integer) is
begin
I := I+1;
X := X+1;
end;
----
procedure Quadratic(A, B, C: in Real; Root_1, Root_2:
out Real; OK: out Boolean) is
D: constant Real := B**2 - 4.0*A*C;
begin
if D < 0.0 or A = 0.0 then
OK := False;
return;
end if;
Root_1 := (-B+Sqrt(D)) / (2.0*A);
Root_2 := (-B-Sqrt(D)) / (2.0*A);
OK := True;
end Quadratic;
----
declare
L, M, N: Real;
P, Q: Real;
Status: Boolean;
begin
-- sets values into L, M and N
Quadratic(L, M, N, P, Q, Status);
if Status then
-- roots are in P and Q
else
-- fails
end if;
end;
----
begin
OK := D >= 0.0 and A /= 0.0;
if not OK then
return;
end if;
Root_1 := ... ;
Root_2 := ... ;
end Quadratic;
Exercise 7.3
A: Vector(1 .. 1);
procedure P(V: Vector) is
begin
A(1) := V(1)+V(1);
A(1) := V(1)+V(1);
end;
...
A(1) := 1.0;
P(A);
7.6 Declarations, scopes and visibility
procedure F( ... ); -- declaration of F
procedure G( ... ) is -- body of G
begin
F( ... );
end G;
procedure F( ... ) is -- body of F repeats
begin -- its specification
G( ... );
end F;
----
procedure P is
I: Integer := 0;
procedure Q is
K: Integer := I;
I: Integer;
J: Integer;
begin
...
end Q;
begin
...
end P;
----
Outer:
declare
I: Integer := 0;
begin
...
declare
K: Integer := I;
I: Integer;
J: Integer := Outer.I;
begin
...
end;
end Outer;
----
L:
for I in AA'Range(1) loop
for I in AA'Range(2) loop
AA(L.I, I) := 0.0;
end loop;
end loop L;
Chapter 8 Overall Structure
8.1 Packages
procedure Push(X: Integer) is
begin
Top := Top+1;
S(Top) := X;
end Push;
function Pop return Integer is
begin
Top := Top-1;
return S(Top+1);
end Pop;
----
package Stack is -- specification
procedure Push(X: Integer);
function Pop return Integer;
end Stack;
package body Stack is -- body
Max: constant := 100;
S: array (1 .. Max) of Integer;
Top: Integer range 0 .. Max;
procedure Push(X: Integer) is
begin
Top := Top+1;
S(Top) := X;
end Push;
function Pop return Integer is
begin
Top := Top-1;
return S(Top+1);
end Pop;
begin -- initialization
Top := 0;
end Stack;
----
declare
package Stack is -- specification
... -- and
... -- body
end Stack;
begin
...
Stack.Push(M);
...
N := Stack.Pop;
...
end;
----
declare
use Stack;
begin
...
Push(M);
...
N := Pop;
...
end;
----
package Diurnal is
type Day is (Mon, Tue, Wed, Thu, Fri, Sat, Sun);
subtype Weekday is Day range Mon .. Fri;
Tomorrow: constant array (Day) of Day
:= (Tue, Wed, Thu, Fri, Sat, Sun, Mon);
Next_Work_Day: constant array (Weekday) of Weekday
:= (Tue, Wed, Thu, Fri, Mon);
end Diurnal;
8.2 Library units
package Stack is
...
end Stack;
package body Stack is
...
end Stack;
----
with Stack;
procedure Main is
use Stack;
M, N: Integer;
begin
...
Push(M);
...
N := Pop;
...
end Main;
8.3 Subunits
package body Stack is
Max: constant := 100;
S: array (1 .. Max) of Integer;
Top: Integer range 0 .. Max;
procedure Push(X: Integer) is separate; -- stub
function Pop return Integer is separate; -- stub
begin
Top := 0;
end Stack;
----
separate (Stack)
procedure Push(X: Integer) is
begin
Top := Top+1;
S(Top) := X;
end Push;
8.4 Scope and visibility
declare
type R is
record
I: Integer;
end record;
type S is
record
I: Integer;
end record;
AR: R;
AS: S;
I: Integer;
begin
...
I := AR.I+AS.I; -- legal
...
end;
----
package P1 is
package P2 is
...
end P2;
...
end P1;
8.5 Renaming
declare
procedure S_Push(X: Integer) renames Stack.Push;
function S_Pop return Integer renames Stack.Pop;
begin
...
S_Push(M);
...
N := S_Pop;
...
end;
----
for I in People'Range loop
Put(People(I).Birth.Day); Put(":");
Put(Month_Name'Pos(People(I).Birth.Month)+1);
Put(":");
Put(People(I).Birth.Year);
end loop;
----
for I in People'Range loop
declare
D: Date renames People(I).Birth;
begin
Put(D.Day); Put(":");
Put(Month_Name'Pos(D.Month)+1);
Put(":");
Put(D.Year);
end;
end loop;
Chapter 9 Private Types
9.1 Normal private types
package Complex_Numbers is
type Complex is
record
Rl, Im: Real;
end record;
I: constant Complex := (0.0, 1.0);
function "+" (X: Complex) return Complex; -- unary +
function "-" (X: Complex) return Complex; -- unary -
function "+" (X, Y: Complex) return Complex;
function "-" (X, Y: Complex) return Complex;
function "*" (X, Y: Complex) return Complex;
function "/" (X, Y: Complex) return Complex;
end;
----
package Complex_Numbers is
type Complex is private;
I: constant Complex;
function "+" (X: Complex) return Complex;
function "-" (X: Complex) return Complex;
function "+" (X, Y: Complex) return Complex;
function "-" (X, Y: Complex) return Complex;
function "*" (X, Y: Complex) return Complex;
function "/" (X, Y: Complex) return Complex;
function Cons(R, I: Real) return Complex;
function Rl_Part(X: Complex) return Real;
function Im_Part(X: Complex) return Real;
private
type Complex is
record
Rl, Im: Real;
end record;
I: constant Complex := (0.0, 1.0);
end;
----
package body Complex_Numbers is
-- unary + -
function "+" (X, Y: Complex) return Complex is
begin
return (X.Rl + Y.Rl, X.Im + Y.Im);
end "+";
-- plus - * / similarly
function Cons(R, I: Real) return Complex is
begin
return (R, I);
end Cons;
function Rl_Part(X: Complex) return Real is
begin
return X.Rl;
end Rl_Part;
-- Im_Part similarly
end Complex_Numbers;
----
declare
use Complex_Numbers;
C, D: Complex;
R, S: Real;
begin
C := Cons(1.5, -6.0);
D := C + I; -- Complex +
R := Rl_Part(D) + 6.0; -- Real +
...
end;
----
private
Pi: constant := 3.14159_26536;
type Complex is
record
R: Real;
Theta: Real range 0.0 .. 2.0*Pi;
end record;
I: constant Complex := (1.0, 0.5*Pi);
end;
Exercise 9.1
package Rational_Numbers is
type Rational is private;
function "+" (X: Rational) return Rational; -- unary +
function "-" (X: Rational) return Rational; -- unary -
function "+" (X, Y: Rational) return Rational;
function "-" (X, Y: Rational) return Rational;
function "*" (X, Y: Rational) return Rational;
function "/" (X, Y: Rational) return Rational;
function "/" (X: Integer; Y: Positive) return Rational;
function Numerator(R: Rational) return Integer;
function Denominator(R: Rational) return Positive;
private
...
end;
9.2 Limited private types
package Stacks is
type Stack is limited private;
procedure Push(S: in out Stack; X: in Integer);
procedure Pop(S: in out Stack; X: out Integer);
function "=" (S, T: Stack) return Boolean;
private
Max: constant := 100;
type Integer_Vector is array (Integer range <>) of Integer;
type Stack is
record
S: Integer_Vector(1 .. Max);
Top: Integer range 0 .. Max := 0;
end record;
end;
----
package body Stacks is
procedure Push(S: in out Stack; X: in Integer) is
begin
S.Top := S.Top+1;
S.S(S.Top) := X;
end Push;
procedure Pop(S: in out Stack; X: out Integer) is
begin
X := S.S(S.Top);
S.Top := S.Top-1;
end Pop;
function "=" (S, T: Stack) return Boolean is
begin
if S.Top /= T.Top then
return False;
end if;
for I in 1 .. S.Top loop
if S.S(I) /= T.S(I) then
return False;
end if;
end loop;
return True;
end "=";
end Stacks;
----
declare
use Stacks;
St: Stack;
Empty: Stack;
...
begin
Push(St, N);
...
Pop(St, M);
...
if St = Empty then
...
end if;
...
end;
9.3 Resource management
package Key_Manager is
type Key is limited private;
procedure Get_Key(K: in out Key);
procedure Return_Key(K: in out Key);
function Valid(K: Key) return Boolean;
...
procedure Action(K: in Key; ... );
...
private
Max: constant := 100; -- number of keys
subtype Key_Code is Integer range 0 .. Max;
type Key is
record
Code: Key_Code := 0;
end record;
end;
package body Key_Manager is
Free: array (Key_Code range 1 .. Key_Code'Last) of
Boolean := (others => True);
function Valid(K: Key) return Boolean is
begin
return K.Code /= 0;
end Valid;
procedure Get_Key(K: in out Key) is
begin
if K.Code = 0 then
for I in Free'Range loop
if Free(I) then
Free(I) := False;
K.Code := I;
return;
end if;
end loop;
-- all keys in use
end if;
end Get_Key;
procedure Return_Key(K: in out Key) is
begin
if K.Code /= 0 then
Free(K.Code) := True;
K.Code := 0;
end if;
end Return_Key;
...
procedure Action(K: in Key; ... ) is
begin
if Valid(K) then
...
end Action;
end Key_Manager;
----
declare
use Key_Manager;
My_Key: Key;
begin
...
Get_Key(My_Key);
...
Action(My_Key, ... );
...
Return_Key(My_Key);
...
end;
Exercise 9.3
package Bank is
subtype Money is Natural;
type Key is limited private;
procedure Open_Account(K: in out Key; M: in Money);
-- open account with initial deposit M
procedure Close_Account(K: in out Key; M: out Money);
-- close account and return balance
procedure Deposit(K: in Key; M: in Money);
-- deposit amount M
procedure Withdraw(K: in out Key; M in out Money);
-- withdraw amount M; if account does not contain M
-- then return what is there and close account
function Statement(K: Key) return Money;
-- returns a statement of current balance
function Valid(K: Key) return Boolean;
-- checks the key is valid
private
...
----
declare
use Key_Manager;
My_Key: Key;
procedure Cheat(Copy: in out Key) is
begin
Return_Key(My_Key);
Action(Copy, ... );
...
end;
begin
Get_Key(My_Key);
Cheat(My_Key);
...
end;
----
declare
use Key_Manager;
My_Key: Key;
procedure Destroy(K: out Key) is
begin
null;
end;
begin
Get_Key(My_Key);
Destroy(My_Key);
...
end;
Chapter 10 Exceptions
10.1 Handling exceptions
begin
-- sequence of statements
exception
when Constraint_Error =>
-- do something
end;
----
begin
Tomorrow := Day'Succ(Today);
exception
when Constraint_Error =>
Tomorrow := Day'First;
end;
----
begin
-- sequence of statements
exception
when Numeric_Error Constraint_Error =>
Put("Numeric or Constraint Error occurred");
...
when Storage_Error =>
Put("Ran out of space");
...
when others =>
Put("Something else went wrong");
...
end;
----
function Tomorrow(Today: Day) return Day is
begin
return Day'Succ(Today);
exception
when Constraint_Error =>
return Day'First;
end Tomorrow;
10.2 Declaring and raising exceptions
declare
use Stack;
begin
...
Push(M);
...
N := Pop;
...
exception
when Constraint_Error =>
-- stack manipulation incorrect?
end;
----
package Stack is
Error: exception;
procedure Push(X: Integer);
function Pop return Integer;
end Stack;
package body Stack is
Max: constant := 100;
S: array (1 .. Max) of Integer;
Top: Integer range 0 .. Max;
procedure Push(X: Integer) is
begin
if Top = Max then
raise Error;
end if;
Top := Top+1;
S(Top) := X;
end Push;
function Pop return Integer is
begin
if Top = 0 then
raise Error;
end if;
Top := Top-1;
return S(Top+1);
end Pop;
begin
Top := 0;
end Stack;
----
declare
use Stack;
begin
...
Push(M);
...
N := Pop;
...
exception
when Error =>
-- stack manipulation incorrect
when others =>
-- something else went wrong
end;
----
declare
use Stack, Key_Manager;
My_Key: Key;
procedure Clean_Up is
begin
Reset;
Return_Key(My_Key);
end;
begin
Get_Key(My_Key);
...
Push(M);
...
Action(My_Key, ... );
...
N := Pop;
...
Return_Key(My_Key);
exception
when Error =>
Put("Stack used incorrectly");
Clean_Up;
when others =>
Put("Something else went wrong");
Clean_Up;
end;
----
procedure Reset is
Junk: Integer;
use Stack;
begin
loop
Junk := Pop;
end loop;
exception
when Error =>
null;
end Reset;
----
exception
when Error =>
Put("Stack used incorrectly");
Clean_Up;
raise Another_Error;
when others =>
...
end;
----
declare
use Stack;
OK: Boolean;
begin
...
Push(M, OK);
if not OK then ... end if;
...
Pop(N, OK);
if not OK then ... end if;
end;
10.3 Checking and exceptions
...
S: array (1 .. Max) of Integer;
Top: Integer range 0 .. Max;
procedure Push(X: Integer) is
begin
Top := Top+1;
S(Top) := X;
end Push;
----
procedure Push(X: Integer) is
begin
if Top = Max then
raise Error;
end if;
Top := Top+1;
S(Top) := X;
end Push;
10.4 Scope of exceptions
declare
procedure P is
X: exception;
begin
raise X;
end P;
begin
P;
exception
when others =>
-- X handled here
end;
----
declare
package P is
procedure F;
procedure H;
end P;
procedure G is
begin
P.H;
exception
when others =>
raise;
end G;
package body P is
X: exception;
procedure F is
begin
G;
exception
when X =>
Put("Got it!");
end F;
procedure H is
begin
raise X;
end H;
end P;
begin
P.F;
end;
----
procedure F(N: Integer) is
X: exception;
begin
if N = 0 then
raise X;
else
F(N-1);
end if;
exception
when X =>
Put("Got it!");
raise;
when others =>
null;
end F;
----
procedure Withdraw (K: in out Key; M: in out Money) is
begin
if Valid (K) then
if M > amount remaining then
M := amount remaining;
Free(K.Code) := True;
K.Code := 0;
raise Alarm;
else
...
end if;
end if;
end Withdraw;
Exercise 10.4
procedure P is
begin
P;
exception
when Storage_Error =>
P;
end P;
Chapter 11 Advanced Types
11.1 Discriminated record types
function Trace(M: Matrix) return Real is
Sum: Real := 0.0;
begin
if M'First(1) /= M'First(2) or M'Last(1) /= M'Last(2) then
raise Non_Square;
end if;
for I in M'Range loop
Sum := Sum + M(I, I);
end loop;
return Sum;
end Trace;
----
function Trace(M: Square) return Real is
Sum: Real := 0.0;
begin
for I in M.Mat'Range loop
Sum := Sum + M.Mat(I, I);
end loop;
return Sum;
end Trace;
----
function Transpose(M: Square) return Square is
R: Square(M.Order);
begin
for I in 1 .. M.Order loop
for J in 1 .. M.Order loop
R.Mat(I, J) := M.Mat(J, I);
end loop;
end loop;
return R;
end Transpose;
----
package Stacks is
type Stack(Max: Natural) is limited private;
procedure Push(S: in out Stack; X: in Integer);
procedure Pop(S: in out Stack; X out Integer);
function "=" (S, T: Stack) return Boolean;
private
type Integer_Vector is array (Integer range <>) of Integer;
type Stack(Max: Natural) is
record
S: Integer_Vector(1 .. Max);
Top: Integer := 0;
end record;
end;
11.2 Default discriminants
function Normal(P: Polynomial) return Polynomial is
Size: Integer := P.N;
begin
while Size > 0 and P.A(Size) = 0 loop
Size := Size-1;
end loop;
return (Size, P.A(0 .. Size));
end Normal;
----
subtype String_Size is Integer range 0 .. 80;
type V_String(N: String_Size := 0) is
record
S: String(1 .. N);
end record;
11.3 Variant parts
type Gender is (Male, Female);
type Person(Sex: Gender) is
record
Birth: Date;
case Sex is
when Male =>
Bearded: Boolean;
when Female =>
Children: Integer;
end case;
end record;
----
type Gender is (Male, Female, Neuter);
type Mutant(Sex: Gender := Neuter) is
record
Birth: Date;
case Sex is
when Male =>
Bearded: Boolean;
when Female =>
Children: Integer;
when Neuter =>
null;
end case;
end record;
11.4 Access Types
type Cell;
type Link is access Cell;
type Cell is
record
Value: Integer;
Next: Link;
end record;
L: Link;
----
function Sum(List: Link) return Integer is
L: Link := List;
S: Integer := 0;
begin
while L /= null loop
S := S+L.Value;
L := L.Next;
end loop;
return S;
end Sum;
----
type Node;
type Tree is access Node;
type Node is
record
Value: Real;
Left, Right: Tree;
end record;
----
procedure Sort(A: in out Vector) is
I: Integer;
Base: Tree := null;
procedure Insert(T: in out Tree; V: Real) is
begin
if T = null then
T := new Node'(V, null, null);
else
if V < T.Value then
Insert(T.Left, V);
else
Insert(T.Right, V);
end if;
end if;
end Insert;
procedure Output(T: Tree) is
begin
if T /= null then
Output(T.Left);
A(I) := T.Value;
I := I+1;
Output(T.Right);
end if;
end Output;
begin -- body of Sort
for J in A'Range loop
Insert(Base, A(J));
end loop;
I := A'First;
Output(Base);
end Sort;
11.5 Access types and private types
package Stacks is
type Stack is limited private;
procedure Push(S: in out Stack; X: in Integer);
procedure Pop(S: in out Stack; X: out Integer);
private
type Cell;
type Stack is access Cell;
type Cell is
record
Value: Integer;
Next: Stack;
end record;
end;
package body Stacks is
procedure Push(S: in out Stack; X: in Integer) is
begin
S := new Cell'(X, S);
end;
procedure Pop(S: in out Stack; X: out Integer) is
begin
X := S.Value;
S := S.Next;
end;
end Stacks;
----
function "=" (S, T: Stack) return Boolean is
SS: Stack := S;
TT: Stack := T;
begin
while SS /= null and TT /= null loop
SS := SS.Next;
TT := TT.Next;
if SS.Value /= TT.Value then
return False;
end if;
end loop;
return SS = TT; -- True if both null
end;
----
type Cell;
type Link is access Cell;
type Cell is
record
Value: Integer;
Next: Link;
end record;
type Stack is
record
List: Link;
end record;
Exercise 11.5
package Queues is
Empty: exception;
type Queue is limited private;
procedure Join(Q: in out Queue; X: in Item);
procedure Remove(Q: in out Queue; X: out Item);
function Length(Q: Queue) return Integer;
private
11.6 Access types and constraints
type Person;
type Person_Name is access Person;
type Person is
record
Sex: Gender;
Birth: Date;
Spouse: Person_Name;
Father: Person_Name;
First_Child: Person_Name;
Next_Sibling: Person_Name;
end record;
----
type Person(Sex: Gender);
type Person_Name is access Person;
type Person(Sex: Gender) is
record
Birth: Date;
Father: Person_Name(Male);
Next_Sibling: Person_Name;
case Sex is
when Male =>
Wife: Person_Name(Female);
when Female =>
Husband: Person_Name(Male);
First_Child: Person_Name;
end case;
end record;
----
procedure Marry(Bride: Womans_Name;
Groom: Mans_Name) is
begin
if Bride.Husband /= null or Groom.Wife /= null then
raise Bigamy;
end if;
Bride.Husband := Groom;
Groom.Wife := Bride;
end Marry;
----
function Spouse(P: Person_Name) return Person_Name is
begin
case P.Sex is
when Male =>
return P.Wife;
when Female =>
return P.Husband;
end case;
end Spouse;
----
function New_Child(Mother: Womans_Name;
Boy_Or_Girl: Gender; Birthday: Date)
return Person_Name is
Child: Person_Name;
begin
if Mother.Husband = null then
raise Illegitimate;
end if;
Child := new Person(Boy_Or_Girl);
Child.Birth := Birthday;
Child.Father := Mother.Husband;
declare
Last: Person_Name := Mother.First_Child;
begin
if Last = null then
Mother.First_Child := Child;
else
while Last.Next_Sibling /= null loop
Last := Last.Next_Sibling;
end loop;
Last.Next_Sibling := Child;
end if;
end;
return Child;
end New_Child;
11.7 Derived types
type Cell;
type Link is access Cell;
type Cell is
record
Value: Integer;
Next: Link;
end record;
type Stack is new Link;
----
function "=" (S, T: Stack) return Boolean is
SL: Link := Link(S);
TL: Link := Link(T);
begin
-- as the answer to Exercise 11.5(2)
end "=";
Chapter 12 Numeric Types
12.4 Fixed point types
private
Pi: constant := 3.14159_26536;
type Angle is delta 0.1 range -4*Pi .. 4*Pi;
for Angle'Small use Pi*2**(-13);
type Complex is
record
R: Real;
Theta: Angle range -Pi .. Pi;
end record;
I: constant Complex := (1.0, 0.5*Pi);
end;
----
function Normal(A: Angle) return Angle is
begin
if A >= Pi then
return A - Angle(2*Pi);
elsif A < -Pi then
return A + Angle(2*Pi);
else
return A;
end if;
end Normal;
----
package body Complex_Numbers is
function Normal ... -- as above
...
function "*" (X, Y: Complex) return Complex is
begin
return (X.R * Y.R, Normal(X.Theta + Y.Theta));
end "*";
...
function Rl_Part(X: Complex) return Real is
begin
return X.R * Cos(X.Theta);
end Rl_Part;
...
end Complex_Numbers;
Chapter 13 Generics
13.1 Declarations and instantiations
procedure Swap(X, Y: in out Real) is
T: Real;
begin
T := X; X := Y; Y := T;
end;
----
generic
type Item is private;
procedure Exchange(X, Y: in out Item);
procedure Exchange(X, Y: in out Item) is
T: Item;
begin
T := X; X := Y; Y := T;
end;
----
generic
Max: Positive;
type Item is private;
package Stack is
procedure Push(X: Item);
function Pop return Item;
end Stack;
package body Stack is
S: array (1 .. Max) of Item;
Top: Integer range 0 .. Max;
-- etc. as before but with Integer
-- replaced by Item
end Stack;
----
declare
package My_Stack is new Stack(100, Real);
use My_Stack;
begin
...
Push(X);
...
Y := Pop;
...
end;
----
generic
Max: Positive;
type Item is private;
package Stack is
Error: exception;
procedure Push(X: Item);
function Pop return Item;
end Stack;
----
package All_Stacks is
Error: exception;
generic
Max: Positive;
type Item is private;
package Stack is
procedure Push(X: Item);
function Pop return Item;
end Stack;
end All_Stacks;
package body All_Stacks is
package body Stack is
...
end Stack;
end All_Stacks;
----
generic
type Thing is private;
procedure Cab(A, B, C: in out Thing);
procedure Cab(A, B, C: in out Thing) is
procedure Swap is new Exchange(Item => Thing);
begin
Swap(A, B);
Swap(A, C);
end Cab;
13.2 Type parameters
generic
type T is (<>);
function Next(X: T) return T;
function Next(X: T) return T is
begin
if X=T'Last then
return T'First;
else
return T'Succ(X);
end if;
end Next;
----
generic
type Real is digits <>;
package Generic_Complex_Numbers is
type Complex is private;
-- as before
I: constant Complex := (0.0, 1.0);
end;
----
generic
type Index is (<>);
type Floating is digits <>;
type Vec is array (Index range <>) of Floating;
function Sum(A: Vec) return Floating;
function Sum(A: Vec) return Floating is
Result: Floating := 0.0;
begin
for I in A'Range loop
Result := Result+A(I);
end loop;
return Result;
end Sum;
----
generic
type Base is (<>);
package Set_Of is
type Set is private;
type List is array (Positive range <>) of Base;
Empty, Full: constant Set;
function Make_Set(X: List) return Set;
function Make_Set(X: Base) return Set;
function Decompose(X: Set) return List;
function "+" (X, Y: Set) return Set; -- union
function "*" (X, Y: Set) return Set; -- intersection
function "-" (X, Y: Set) return Set; -- symmetric difference
function "<" (X: Base; Y: Set) return Boolean; -- inclusion
function "<=" (X, Y: Set) return Boolean; -- contains
function Size(X: Set) return Natural; -- no of elements
private
type Set is array (Base) of Boolean;
Empty: constant Set := (Set'Range => False);
Full: constant Set := (Set'Range => True);
end;
----
generic
type Base is (<>);
type Index is (<>);
type List is array (Index range <>) of Base;
package Nice_Set_Of is
type Set is private;
function Empty return Set;
function Full return Set;
...
private
----
type Primary_List is array (Positive range <>) of Primary;
package Primary_Sets is new Nice_Set_Of(Base => Primary,
Index => Positive,
List => Primary_List);
type Colour is new Primary_Sets.Set;
13.3 Subprogram parameters
generic
type Index is (<>);
type Item is (<>);
type Collection is array (Index range <>) of Item;
procedure Sort(C: in out Collection);
----
procedure Sort(C: in out Collection) is
Min: Index;
Temp: Item;
begin
for I in C'First .. Index'Pred(C'Last) loop
Min := I;
for J in Index'Succ(I) .. C'Last loop
if C(J) < C(Min) then Min := J; end if; -- use of <
end loop;
Temp := C(I); C(I) := C(Min); C(Min) := Temp;
end loop;
end Sort;
----
generic
type Index is (<>);
type Item is private;
type Collection is array (Index range <>) of Item;
with function "<" (X, Y: Item) return Boolean;
procedure Sort(C: in out Collection);
----
procedure Reverse_Sort_Vector is
new Sort(Index => Integer,
Item => Real,
Collection => Vector,
"<" => ">");
----
subtype String_3 is String(1 .. 3);
procedure Sort_String_3_Array is
new Sort(Positive, String_3, String_3_Array, "<");
...
Sort_String_3_Array(Farmyard);
----
type Date_Array is array (Positive range <>) of Date;
function "<" (X, Y: Date) return Boolean is
begin
if X.Year /= Y.Year then
return X.Year < Y.Year;
elsif X.Month /= Y.Month then
return X.Month < Y.Month;
else
return X.Day < Y.Day;
end if;
end "<";
procedure Sort_Date_Array is
new Sort(Positive, Date, Date_Array);
----
generic
type Index is (<>);
type Item is private;
type Vec is array (Index range <>) of Item;
with function "+" (X, Y: Item) return Item;
function Apply(A: Vec) return Item;
function Apply(A: Vec) return Item is
Result: Item := A(A'First);
begin
for I in Index'Succ(A'First) .. A'Last loop
Result := Result+A(I);
end loop;
return Result;
end Apply;
----
function G(T: Real) return Real is
begin
return Exp(T)*Sin(T);
end;
function Integrate_G is new Integrate(G);
13.4 The mathematical library
with Elementary_Functions_Exceptions;
generic
type Float_Type is digits <>;
package Generic_Elementary_Functions is
function Sqrt (X: Float_Type) return Float_Type;
function Log (X: Float_Type) return Float_Type;
function Log (X, Base: Float_Type) return Float_Type;
function Exp (X: Float_Type) return Float_Type;
function "**" (Left, Right: Float_Type) return Float_Type;
function Sin (X: Float_Type) return Float_Type;
function Sin (X, Cycle: Float_Type) return Float_Type;
function Cos (X: Float_Type) return Float_Type;
function Cos (X, Cycle: Float_Type) return Float_Type;
function Tan (X: Float_Type) return Float_Type;
function Tan (X, Cycle: Float_Type) return Float_Type;
function Cot (X: Float_Type) return Float_Type;
function Cot (X, Cycle: Float_Type) return Float_Type;
function Arcsin (X: Float_Type) return Float_Type;
function Arcsin (X, Cycle: Float_Type) return Float_Type;
function Arccos (X: Float_Type) return Float_Type;
function Arccos (X, Cycle: Float_Type) return Float_Type;
function Arctan (Y: Float_Type; X: Float_Type := 1.0)
return Float_Type;
function Arctan (Y: Float_Type; X: Float_Type := 1.0;
Cycle: Float_Type) return Float_Type;
function Arccot (X: Float_Type; Y: Float_Type := 1.0)
return Float_Type;
function Arccot (X: Float_Type; Y: Float_Type := 1.0;
Cycle: Float_Type) return Float_Type;
function Sinh (X: Float_Type) return Float_Type;
function Cosh (X: Float_Type) return Float_Type;
function Tanh (X: Float_Type) return Float_Type;
function Coth (X: Float_Type) return Float_Type;
function Arcsinh (X: Float_Type) return Float_Type;
function Arccosh (X: Float_Type) return Float_Type;
function Arctanh (X: Float_Type) return Float_Type;
function Arccoth (X: Float_Type) return Float_Type;
Argument_Error: exception
renames Elementary_Functions_Exceptions.Argument_Error;
end Generic_Elementary_Functions;
----
generic
type Real_Type is digits <>;
type Complex_Type is private;
with function Cons(R, I: Real_Type) return Complex_Type is <>;
with function Cons_Polar(R, Theta: Real_Type) return
Complex_Type is <>;
with function Rl_Part(X: Complex_Type) return Real_Type is <>;
with function Im_Part(X: Complex_Type) return Real_Type is <>;
with function "abs" (X: Complex_Type) return Real_Type is <>;
with function Arg (X: Complex_Type) return Real_Type is <>;
with function Sqrt (X: Real_Type) return Real_Type is <>;
with function Log (X: Real_Type) return Real_Type is <>;
with function Exp (X: Real_Type) return Real_Type is <>;
with function Sin (X: Real_Type) return Real_Type is <>;
with function Cos (X: Real_Type) return Real_Type is <>;
with function Sinh (X: Real_Type) return Real_Type is <>;
with function Cosh (X: Real_Type) return Real_Type is <>;
package Generic_Complex_Functions is
function Sqrt(X: Complex_Type) return Complex_Type;
function Log (X: Complex_Type) return Complex_Type;
function Exp (X: Complex_Type) return Complex_Type;
function Sin (X: Complex_Type) return Complex_Type;
function Cos (X: Complex_Type) return Complex_Type;
end Generic_Complex_Functions;
----
type My_Real is digits 9;
package My_Elementary_Functions is
new Generic_Elementary_Functions(Float_Type => My_Real);
package My_Complex_Numbers is
new Generic_Complex_Numbers(Real => My_Real);
use My_Elementary_Functions, My_Complex_Numbers;
package My_Complex_Functions is
new Generic_Complex_Functions(My_Real, Complex);
use My_Complex_Functions;
Chapter 14 Tasking
14.1 Parallelism
task T is -- specification
...
end T;
task body T is -- body
...
end T;
----
procedure Shopping is
begin
Buy_Meat;
Buy_Salad;
Buy_Wine;
end;
----
procedure Shopping is
task Get_Salad;
task body Get_Salad is
begin
Buy_Salad;
end Get_Salad;
task Get_Wine;
task body Get_Wine is
begin
Buy_Wine;
end Get_Wine;
begin
Buy_Meat;
end Shopping;
14.2 The rendezvous
procedure Shopping is
task Get_Salad is
entry Pay(M: in Money);
entry Collect(S: out Salad);
end Get_Salad;
task body Get_Salad is
Cash: Money;
Food: Salad;
begin
accept Pay(M: in Money) do
Cash := M;
end Pay;
Food := Buy_Salad(Cash);
accept Collect(S: out Salad) do
S := Food;
end Collect;
end Get_Salad;
-- Get_Wine similarly
begin
Get_Salad.Pay(50);
Get_Wine.Pay(100);
MM := Buy_Meat(200);
Get_Salad.Collect(SS);
Get_Wine.Collect(WW);
end Shopping;
----
task Buffering is
entry Put(X: in Item);
entry Get(X: out Item);
end;
task body Buffering is
V: Item;
begin
loop
accept Put(X: in Item) do
V := X;
end Put;
accept Get(X: out Item) do
X := V;
end Get;
end loop;
end Buffering;
Exercise 14.2
task Build_Complex is
entry Put_Rl(X: in Real);
entry Put_Im(X: in Real);
entry Get_Comp(X: out Complex);
end;
14.3 Timing and scheduling
task Buffering is
pragma Priority(7);
entry Put ...
...
end;
----
package Calendar is
type Time is private;
subtype Year_Number is Integer range 1901 .. 2099;
subtype Month_Number is Integer range 1 .. 12;
subtype Day_Number is Integer range 1 .. 31;
subtype Day_Duration is Duration range 0.0 .. 86_400.0;
function Clock return Time;
function Year(Date: Time) return Year_Number;
function Month(Date: Time) return Month_Number;
function Day(Date: Time) return Day_Number;
function Seconds(Date: Time) return Day_Duration;
procedure Split(Date: in Time;
Year: out Year_Number;
Month: out Month_Number;
Day: out Day_Number;
Seconds: out Day_Duration);
function Time_Of(Year: Year_Number;
Month: Month_Number;
Day: Day_Number;
Seconds: Day_Duration := 0.0) return Time;
function "+" (Left: Time; Right: Duration) return Time;
function "+" (Left: Duration; Right: Time) return Time;
function "-" (Left: Time; Right: Duration) return Time;
function "-" (Left: Time; Right: Time) return Duration;
function "<" (Left, Right: Time) return Boolean;
function "<=" (Left, Right: Time) return Boolean;
function ">" (Left, Right: Time) return Boolean;
function ">=" (Left, Right: Time) return Boolean;
Time_Error: exception;
-- can be raised by Time_Of, +, and -
private
-- implementation dependent
end Calendar;
----
declare
use Calendar;
Interval: constant Duration := 5*Minutes;
Next_Time: Time := First_Time;
begin
loop
delay Next_Time - Clock;
Action;
Next_Time := Next_Time + Interval;
end loop;
end;
14.4 Simple select statements
package Protected_Variable is
procedure Read(X: out Item);
procedure Write(X: in Item);
end;
package body Protected_Variable is
V: Item;
procedure Read(X: out Item) is
begin
X := V;
end;
procedure Write(X: in Item) is
begin
V := X;
end;
begin
V := initial value;
end Protected_Variable;
----
type Item is
record
X_Coord: Real;
Y_Coord: Real;
end record;
----
task Protected_Variable is
entry Read(X: out Item);
entry Write(X: in Item);
end;
task body Protected_Variable is
V: Item;
begin
accept Write(X: in Item) do
V := X;
end;
loop
select
accept Read(X: out Item) do
X := V;
end;
or
accept Write(X: in Item) do
V := X;
end;
end select;
end loop;
end Protected_Variable;
----
task Buffering is
entry Put(X: in Item);
entry Get(X: out Item);
end;
task body Buffering is
N: constant := 8; -- for instance
A: array (1 .. N) of Item;
I, J: Integer range 1 .. N := 1;
Count: Integer range 0 .. N := 0;
begin
loop
select
when Count < n ="">
accept Put(X: in Item) do
A(I) := X;
end;
I := I mod N+1; Count := Count+1;
or
when Count > 0 =>
accept Get(X: out Item) do
X := A(J);
end;
J := J mod N+1; Count := Count-1;
end select;
end loop;
end Buffering;
----
package Reader_Writer is
procedure Read(X: out Item);
procedure Write(X: in Item);
end;
package body Reader_Writer is
V: Item;
task Control is
entry Start;
entry Stop;
entry Write(X: in Item);
end;
task body Control is
Readers: Integer := 0;
begin
accept Write(X: in Item) do
V := X;
end;
loop
select
accept Start;
Readers := Readers+1;
or
accept Stop;
Readers := Readers-1;
or
when Readers = 0 =>
accept Write(X: in Item) do
V := X;
end;
end select;
end loop;
end Control;
procedure Read(X: out Item) is
begin
Control.Start;
X := V;
Control.Stop;
end Read;
procedure Write(X: in Item) is
begin
Control.Write(X);
end Write;
end Reader_Writer;
----
select
when Write'Count = 0 =>
accept Start;
Readers := Readers+1;
or
accept Stop;
Readers := Readers-1;
or
when Readers = 0 =>
accept Write(X: in Item) do
V := X;
end;
end select;
14.5 Timed and conditional rendezvous
select
accept Read( ... ) do
...
end;
or
accept Write( ... ) do
...
end;
or
delay 10*Minutes;
-- time out statements
end select;
----
Operator.Call("Put out fire");
select
accept Acknowledge;
or
delay 1*Minutes;
Fire_Brigade.Call;
end select;
----
select
accept Read( ... ) do
...
end;
or
accept Write( ... ) do
...
end;
else
-- alternative statements
end select;
----
select
accept Acknowledge;
else
delay 1*Minutes;
Fire_Brigade.Call;
end select;
----
select
Operator.Call("Put out fire");
or
delay 1*Minutes;
Fire_Brigade.Call;
end select;
----
select
Operator.Call("Put out fire");
else
Fire_Brigade.Call;
end select;
----
procedure Write(X: in Item; T: Duration; OK: out Boolean) is
begin
select
Control.Write(X);
OK := True;
or
delay T;
OK := False;
end select;
end Write;
----
package body Reader_Writer is
V: Item;
type Service is (Read, Write);
task Control is
entry Start(S: Service);
entry Stop_Read;
entry Write;
entry Stop_Write;
end Control;
task body Control is
Readers: Integer := 0;
Writers: Integer := 0;
begin
loop
select
when Writers = 0 =>
accept Start(S: Service) do
case S is
when Read =>
Readers := Readers+1;
when Write =>
Writers := 1;
end case;
end Start;
or
accept Stop_Read;
Readers := Readers-1;
or
when Readers = 0 =>
accept Write;
or
accept Stop_Write;
Writers := 0;
end select;
end loop;
end Control;
procedure Read(X: out Item) is
begin
Control.Start(Read);
X := V;
Control.Stop_Read;
end Read;
procedure Write(X: in Item) is
begin
Control.Start(Write);
Control.Write;
V := X;
Control.Stop_Write;
end Write;
end Reader_Writer;
----
task Control is
entry Start(S: Service);
entry Stop;
end Control;
task body Control is
Readers: Integer := 0;
begin
loop
select
accept Start(S: Service) do
case S is
when Read =>
Readers := Readers+1;
when Write =>
while Readers > 0 loop
accept Stop; -- from readers
Readers := Readers-1
end loop;
end case;
end Start;
if Readers = 0 then
accept Stop; -- from the writer
end if;
or
accept Stop; -- from a reader
Readers := Readers-1;
end select;
end loop;
end Control;
procedure Read(X: out Item) is
begin
Control.Start(Read);
X := V;
Control.Stop;
end Read;
procedure Write(X: in Item) is
begin
Control.Start(Write);
V := X;
Control.Stop;
end Write;
14.6 Task types and activation
task type T is
entry E( ... );
end T;
task body T is
...
end T;
----
type Rec is
record
CT: T;
...
end record;
R: Rec;
----
declare
...
A: T;
B: T;
...
begin
...
end;
----
type R is
record
A: T;
I: Integer := E;
B: T;
end record;
----
declare
XA: T;
XI: Integer := E;
XB: T;
begin
----
task type Mailbox is
entry Deposit(X: in Item);
entry Collect(X: out Item);
end;
task body Mailbox is
Local: Item;
begin
accept Deposit(X: in Item) do
Local := X;
end;
accept Collect(X: out Item) do
X := Local;
end;
end Mailbox;
----
task Server is
entry Request(A: Address; X: Item);
end;
task body Server is
Reply: Address;
Job: Item;
begin
loop
accept Request(A: Address; X: Item) do
Reply := A;
Job := X;
end;
-- work on job
Reply.Deposit(Job);
end loop;
end Server;
task User;
task body User is
My_Box: Address := new Mailbox;
My_Item: Item;
begin
Server.Request(My_Box, My_Item);
-- do something while waiting
My_Box.Collect(My_Item);
end User;
----
select
My_Box.Collect(My_Item);
-- item collected successfully
else
-- not ready yet
end select;
----
task body Mailbox is
begin
accept Deposit(X: in Item) do
accept Collect(X: out Item) do
Collect.X := Deposit.X;
end;
end;
end Mailbox;
14.7 Termination and exceptions
task body Protected_Variable is
V: Item;
begin
accept Write(X: in Item) do
V := X;
end;
loop
select
accept Read(X: out Item) do
X := V;
end;
or
accept Write(X: in Item) do
V := X;
end;
or
terminate;
end select;
end loop;
end Protected_Variable;
----
select
T.Closedown;
or
delay 60*Seconds;
abort T;
end select;
----
select
accept Closedown;
-- tidy up and die
else
-- carry on normally
end select;
----
select
T.Closedown;
delay 10*Seconds;
or
delay 60*Seconds;
end select;
abort T;
----
accept Closedown do
loop
Put("Can't catch me");
end loop;
end;
----
task body Control is
Readers: Integer := 0;
begin
loop
select
accept Start(S: Service) do
case S is
when Read =>
Readers := Readers+1;
when Write =>
while Readers > 0 loop
accept Stop; -- from readers
Readers := Readers-1;
end loop;
end case;
end Start;
if Readers = 0 then
accept Stop; -- from the writer
end if;
or
accept Stop; -- from a reader
Readers := Readers-1;
end select;
end loop;
end Control;
----
package body Reader_Writer is
V: Item;
type Service is (Read, Write);
task type Read_Agent is
entry Read(X: out Item);
end;
type RRA is access Read_Agent;
task Control is
entry Start(S: Service);
entry Stop;
end;
task body Control is
-- as before
end Control;
task body Read_Agent is
begin
select
accept Read(X: out Item) do
Control.Start(Read);
X := V;
Control.Stop;
end;
or
terminate;
end select;
end Read_Agent;
procedure Read

Drawing Single Cube

2008-12-11T06:46:00.001-08:00

#include
#include
#include
#include "glut.h"
GLfloat vertices[][3] = {{-1.0,-1.0,-1.0},{1.0,-1.0,-1.0},
{1.0,1.0,-1.0}, {-1.0,1.0,-1.0}, {-1.0,-1.0,1.0},
{1.0,-1.0,1.0}, {1.0,1.0,1.0}, {-1.0,1.0,1.0}};
GLfloat normals[][3] = {{-1.0,-1.0,-1.0},{1.0,-1.0,-1.0},
{1.0,1.0,-1.0}, {-1.0,1.0,-1.0}, {-1.0,-1.0,1.0},
{1.0,-1.0,1.0}, {1.0,1.0,1.0}, {-1.0,1.0,1.0}};
GLfloat colors[][3] = {{0.0,0.0,0.0},{1.0,0.0,0.0},
{1.0,1.0,0.0}, {0.0,1.0,0.0}, {0.0,0.0,1.0},
{1.0,0.0,1.0}, {1.0,1.0,1.0}, {0.0,1.0,1.0}};
void
polygon(int a, int b, int c , int d)
{
glBegin(GL_POLYGON);
glColor3fv(colors[a]);
glNormal3fv(normals[a]);
glVertex3fv(vertices[a]);
glColor3fv(colors[b]);
glNormal3fv(normals[b]);
glVertex3fv(vertices[b]);
glColor3fv(colors[c]);
glNormal3fv(normals[c]);
glVertex3fv(vertices[c]);
glColor3fv(colors[d]);
glNormal3fv(normals[d]);
glVertex3fv(vertices[d]);
glEnd();
}
void
colorcube()
{
polygon(0,3,2,1);
polygon(2,3,7,6);
polygon(0,4,7,3);
polygon(1,2,6,5);
polygon(4,5,6,7);
polygon(0,1,5,4);
}
static GLfloat theta[] = {0.0,0.0,0.0};
static GLint axis = 2;
void
display(void)
{
glClear(GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT);
glLoadIdentity();
glRotatef(theta[0], 1.0, 0.0, 0.0);
glRotatef(theta[1], 0.0, 1.0, 0.0);
glRotatef(theta[2], 0.0, 0.0, 1.0);
colorcube();
glFlush();
}
void spinCube()
{
theta[axis] += 2.0;
if( theta[axis] > 360.0 ) theta[axis] -= 360.0;
display();
}
void mouse(int btn, int state, int x, int y)
{
if(btn==GLUT_LEFT_BUTTON & state == GLUT_DOWN) axis = 0;
if(btn==GLUT_MIDDLE_BUTTON & state == GLUT_DOWN) axis = 1;
if(btn==GLUT_RIGHT_BUTTON & state == GLUT_DOWN) axis = 2;
}
void
myReshape(int w, int h)
{
glViewport(0, 0, w, h);
glMatrixMode(GL_PROJECTION);
glLoadIdentity();
if (w <= h)
glOrtho(-2.0, 2.0, -2.0 * (GLfloat) h / (GLfloat) w,
2.0 * (GLfloat) h / (GLfloat) w, -10.0, 10.0);
else
glOrtho(-2.0 * (GLfloat) w / (GLfloat) h,
2.0 * (GLfloat) w / (GLfloat) h, -2.0, 2.0, -10.0, 10.0);
glMatrixMode(GL_MODELVIEW);
}
void
main(int argc, char **argv)
{
glutInit(&argc, argv);
glutInitDisplayMode(GLUT_SINGLE GLUT_RGB GLUT_DEPTH);
glutInitWindowSize(500, 500);
glutCreateWindow("colorcube");
glutReshapeFunc(myReshape);
glutDisplayFunc(display);
glutIdleFunc(spinCube);
glutMouseFunc(mouse);
glEnable(GL_DEPTH_TEST);
glutMainLoop();
}

program has a variable

2008-12-11T06:18:00.000-08:00

#include
using namespace std;
int main(){
int number; number = 5;
cout << "The value in number is " << number << endl;
return 0;
}

well-adjusted printing program

2008-12-11T06:17:00.002-08:00

#include using namespace std;int main()
{
cout << "The following items were top sellers" << endl; cout << "during the month of June:" << endl; cout << "Computer games" << endl; cout << "Coffee" << endl; cout << "Aspirin" << endl; return 0;
}

printing program

2008-12-11T06:17:00.001-08:00

// An unruly printing program
#include
using namespace std;
int main()
{
cout << "The following items were top sellers";
cout << "during the month of June:";
cout << "Computer games";
cout << "Coffee";
cout << "Aspirin";
return 0;
}

calculates the user's pay

2008-12-11T06:15:00.000-08:00

// This progam calculates the user's pay.
#include
using namespace std;
int main()
{
double hours, rate, pay;
// Get the number of hours worked.
cout << "How many hours did you work? ";
cin >> hours;

// Get the hourly pay rate.
cout << "How much do you get paid per hour? ";
cin >> rate;

// Calculate the pay.
pay = hours * rate;

// Display the pay.
cout << "You have earned $" << pay << endl;
return 0;
}

User Authentication

2008-11-19T21:51:00.000-08:00

/*
user.authenticate
Determine if the user blackbeard with a password of avast888 is valid.
*/

include('xmlrpc-2_1/lib/xmlrpc.inc');
include('class.RevverAPI.php');

$api = new RevverAPI('https://api.staging.revver.com/xml/1.0?login=revtester&passwd=testacct');

$username = 'blackbeard';
$password = 'avast888';

$results = $api->callRemote('user.authenticate', $username, $password);

echo '

';
var_dump($results);
echo '

';

?>

Create Video

2008-11-19T21:50:00.000-08:00

/*
video.create
Create the metadata for video 65535.
*/

include('xmlrpc-2_1/lib/xmlrpc.inc');
include('class.RevverAPI.php');

$api = new RevverAPI('https://api.staging.revver.com/xml/1.0?login=revtester&passwd=testacct');

$id = 65535;
$title = 'My New Parrot';
$keywords = array('parrot', 'pet');
$ageRestriction = 1;
$options = array('url' => 'arrvideos.example.com', 'author' => 'Billy Doyle');

$results = $api->callRemote('video.create', $id, $title, $keywords, $ageRestriction, $options);

echo '

';
var_dump($results);
echo '

';

?>

Heap Demo project

2008-11-09T22:04:00.000-08:00

Heap Demo is a project designed to show the relationship between virtual and committed
memory during heap use. Using a contrived scenario, a stair-step growth of virtual
memory can be observed in perfmon.

Open a new cpp file in Visual Studio. copy and paste code from this post. compile the file it will create project for u. then u can proceed further

1. Start the HeapDemo application.
2. Open perfmon.
3. Add counters for Virtual Bytes and Private Bytes for the HeapDemo Process.
4. Change the scale for each counter to 0.0000001 (lowest value).
5. Press ENTER on the console for HeapDemo to start the allocations.
6. Watch the perfmon window as memory is allocated.

Note the stair step behavior of virtual memory. Each time the private bytes nears the amount
of virtual bytes reserved, the memory manager extends the heap by reserving more virtual
memory. Each time the heap is extended, it reserves twice as much as the previous reservation.

// Tthe entry point for the console application.
//

#include
#include

void Test();

int main(int argc, char* argv[])
{
Test();

return 0;
}

void Test()
{
int nCount = 0;
int nTotal = 0;
char c;

// scanf in here only to hold process in initial loaded state to set up PerfMon.
printf("Set up Process Object's Private and Virtual Bytes for Heapdemo.exe, then hit ENTER to start the test\n");
scanf(&c);

Sleep(1000);
while(nTotal < 200000)
{
nCount++;
int (*i)[1024] = new int[100][1024];
nTotal += 100;
printf("Allocated: %d KB\n", nTotal);
Sleep(50);
}

printf("Hit any key to end the test and release all memory\n");
scanf(&c);
}

TCPDate Server / Client

2008-10-23T03:29:00.001-07:00

Welcome to Learn C# - the easy way , by Saurabh Nandu.

This is the implementation of "System.Net.Sockets". In this example we will learn how to use the "TCPListener" and "TCPClient" classes from the "System.Net.Sockets" namespace.
This example consists of two files. The "DateServer" class which uses the "TCPListener" class to accept requests from new clients. Once the client is connected with the server, the server will send it the the Current Date and Time and then disconnect it, and listen for more clients.
The "DateClient" class uses the 'TCPClient" class. It connects to the server on the specified port and send the clients name to the server upon connection.
Once connected it receives the current Date Time from the server and then disconnects from the server.

Execution :
1) Run the DateServer.exe first to start the server .(The server by default listens for connection on port 4554).
2) Run the DateClient.exe which will connect to the server and get the current date time from it.

Download The Code (TCPDate.zip)

Code:
1) DateServer.cs :- The Date Time Server

namespace SaurabhNet {  using System;  using System.Net.Sockets;  using System.Net ;  using System.Threading ;  //Import the necessary Namespaces   //Class which shows the implementation of the TCP Date server 	  public class DateServer   {    private TCPListener myListener ;    private int port = 4554 ;    //The constructor which make the TCPListener start listening on the    //given port.    //It also calls a Thread on the method StartListen().     public DateServer()    {      try{ 	  //start listing on the given port 	  myListener = new TCPListener(port) ; 	  myListener.Start(); 	  Console.WriteLine("Server Ready - Listining for new Connections ...") ; 	  //start the thread which calls the method 'StartListen' 	  Thread th = new Thread(new ThreadStart(StartListen)); 	  th.Start() ; 					 	} 	catch(Exception e) 	{ 	  Console.WriteLine("An Exception Occured while Listing :"+e.ToString()); 	}     } 				     //main entry point of the class     public static void Main(String[] argv)     {       DateServer dts = new DateServer();     }      //This method Accepts new connection and     //First it receives the welcome massage from the client,     //Then it sends the Current time to the Client.     public void StartListen()     {       while(true)       { 	//Accept a new connection 	Socket mySocket = myListener.Accept() ; 	if(mySocket.Connected) 	{ 	  Console.WriteLine("Client Connected!!") ; 	  //make a byte array and receive data from the client  	  Byte[] receive = new Byte[64] ; 	  int i=mySocket.Receive(receive,receive.Length,0) ; 	  char[] unwanted = {' ',' ',' '}; 	  string rece = System.Text.Encoding.ASCII.GetString(receive); 	  Console.WriteLine(rece.TrimEnd(unwanted)) ; 	  //get the current date/time and convert it to string 	  DateTime now = DateTime.Now; 	  String strDateLine ="Server: The Date/Time Now is: "+ now.ToShortDateString()  		+ " " + now.ToShortTimeString(); 	  // Convert to byte array and send 	  Byte[] byteDateLine=Text.Encoding.ASCII.GetBytes(strDateLine.ToCharArray()); 	  mySocket.Send(byteDateLine,byteDateLine.Length,0); 	}       }     }   } }

2) DateClient.cs:- The Date Time Client

namespace SaurabhNet {   using System ;   using System.Net.Sockets ;   using System.Net ;   using System.Threading ; 		   //Class which shows the implementation of the TCP Date Client   public class DateClient    {     //the needed member fields     private TCPClient tcpc;     private string name ;     private int port=4554 ;     private bool readData=false ; 		     //Constructor which contains all the code for the client.     //It connects to the server and sends the clients name,      //Then it waits and receives the date from the server     public DateClient(string name)     {       //a label       tryagain :       this.name=name ;       try       { 	//connect to the "localhost" at the give port 	//if you have some other server name then you can use that  	//instead of "localhost" 	tcpc =new TCPClient("localhost",port) ; 	//get a Network stream from the server 	NetworkStream nts = tcpc.GetStream() ; 	//if the stream is writiable then write to the server 	if(nts.CanWrite) 	{ 	  string sender = "Hi Server I am "+name ; 	  Byte[] sends = System.Text.Encoding.ASCII.GetBytes(sender.ToCharArray()); 	  nts.Write(sends,0,sends.Length) ; 	  //flush to stream  	  nts.Flush() ; 	} 	//make a loop to wait until some data is read from the stream 	while(!readData&&nts.CanRead) 	{ 	  //if data available then read from the stream 	  if(nts.DataAvailable) 	  { 	    byte[] rcd = new byte[128]; 	    int i=nts.Read( rcd,0,128); 	    string ree = System.Text.Encoding.ASCII.GetString(rcd); 	    char[] unwanted = {' ',' ',' '}; 	    Console.WriteLine(ree.TrimEnd(unwanted)) ; 	    //Exit the loop    	    readData=true ; 	   } 	}       }       catch(Exception e)       { 	Console.WriteLine("Could not Connect to server because "+e.ToString()); 	//Here an exception can be cause if the client is started before starting 	//the server. 	//A good way to handle such exceptions and give the client  	//a chance to re-try to connect to the server 	Console.Write("Do you want to try Again? [y/n]: ") ; 	char check = Console.ReadLine().ToChar(); 	if(check=='y'|| check=='Y') 	goto tryagain ;       }     }      //Main Entry point of the client class     public static void Main(string[] argv)     {       //check to see if the user has entered his name       //if not ask him if he wants to enter his name.       if(argv.Length<=0)       { 	Console.WriteLine("Usage: DataClient ") ; 	Console.Write("Would You like to enter your name now [y/n] ?") ; 	char check = Console.ReadLine().ToChar(); 	if(check=='y'|| check=='Y') 	{ 	  Console.Write("Please enter you name :") ; 	  string newname=Console.ReadLine(); 	  DateClient dc = new DateClient(newname) ; 	  Console.WriteLine("Disconnected!!") ; 	  Console.ReadLine() ; 	}       }       else       { 	DateClient dc = new DateClient(argv[0]) ; 	Console.WriteLine("Disconnected!!") ; 	Console.ReadLine() ;       }     }   } }

Symmetric File Encryption / Decryption

2008-10-23T03:27:00.001-07:00

Welcome to Learn C# - the easy way , by Saurabh Nandu.

Cryptography ..... Storing your files in such a way that no-one except you can view the file, does have a lot of importance today. Cryptography is basically of 2 types Asymmetric and Symmetric. Asymmetric encryption is based on the concept of Public and Private Key's. On the other hand Symmetric encryption is based on a single 'Key' . Hence it up to the person to first send the password to the receiver of the file so that he can decrypt it.
In this example we learn how to use 2 of the Symmetric encryption algorithms namely Data Encryption Standard (DES) and RC2. Both these are Key based algorithms. Here we use 64 bit encryption in DES and 40 bit encryption in RC2 .
Also in this example you will learn how to write your own implementations of the "ICryptoStream" interface.
To encrypt the file the user has to select the file to encrypt and the file to save the encrypted data in. The file gets encrypted with the password provided by the user using either of the two algorithms selected by the user.
Decryption checks the input file for validity and the algorithm used in encryption automatically. So you do not have to provide with the encryption algorithm used. The program reads it from the automatically from the encrypted file. If the password provided for decryption is same as the one used for encryption then the file will decrypt.
Both binary and text files can be encrypted / decrypted .
If you have gone through the .NET SDK then you will find that I have used the Microsoft's Example on DES encryption example and built my code on it.
I will give you a rough Idea of how the encryption takes place.
First the Password given by the user is Hashed by the "SHA1_CSP" class. By default the SHA1_CSP class returns a Hash of 20bytes maximum. As I said we are using Symmetric Algorithms which require a 'Key' to work, so then depending on the algorithm the size of the Key defers. In DES we use a 64 bit 'Key' while in 'RC2' we use a 40 bit key. Hence depending on the Key size we store the Hash of the password in a byte array. Also required by the encryption /decryption algorithms is a initialization 'Vector'. The size of the 'Key' and 'Vector' remain the same. So for DES which requires a 64 bit Key, we use a 64 Bit Vector similarly for 'RC2' we use a 40 bit Vector.
Once the Key and Vector are generated these are feed into a "SymmetricStreamEncryptor" class which encrypts / decrypts the bytes depending on the Algorithm , Key and Vector and writes it out to a File.

Download The Code (SymEncryptor.zip)

Code:
1) SymEncryptor.cs :- The File Encryptor / Decryptor (Only relevant code)

namespace SaurabhCrypto {   using System;   using System.Drawing;   using System.ComponentModel;   using System.WinForms;   using System.IO ;   using System.Security;   using System.Security.Cryptography;    //    Class which will Encrypt and Decrypt files   public class SymEncryptor : System.WinForms.Form {      //    Required by the Win Forms designer      private System.ComponentModel.Container components;     private System.WinForms.SaveFileDialog saveFileDialog1;     private System.WinForms.OpenFileDialog openFileDialog1;     private System.WinForms.StatusBar statusBar1;     private System.WinForms.Button decryptb;     private System.WinForms.Button encryptb;     private System.WinForms.RadioButton radioButton2;     private System.WinForms.RadioButton radioButton1;     private System.WinForms.Label infol;     private System.WinForms.TextBox passt;     private System.WinForms.Label passl;     private System.WinForms.Button saveb;     private System.WinForms.Button openb;     private System.WinForms.TextBox savet;     private System.WinForms.TextBox opent;     private System.WinForms.Label savel;     private System.WinForms.Label openl;          //these byte arrays will contain the 'KEY' and 'Vector' used in      //encryption and decryption .     private byte[] symKey ;     private byte[] symIV ;            //This is the constructor of the class.     //It calls only one method 'InitlizeComponent' which draws the WinForm .     public SymEncryptor() {       // Call the method to make the WinForm       InitializeComponent();     }      //This method is called when the WinForm exits and it     //Cleans up any resources being used     public override void Dispose() {       base.Dispose();       components.Dispose();     }     //    The main entry point for the application.     public static void Main(string[] args) {       Application.Run(new SymEncryptor());     }     //Method called from the constructor     //It initialises all the WinForm components     private void InitializeComponent()     { 	//Here the WinForm components are placed 	//I have removed this code for explanation purpose 	//You can get the full code when you download the example	     }     //This method is called when the 'Decrypt' button is clicked by the user.     //It first checks the file type and then calls the required methods to       //decrypt the file .     protected void decryptb_click(object sender, System.EventArgs e)     {       //call the method 'ValidateBoxes()' which checks all the fields of the WinForm and        //returns a 'true' if everything is filled properly       //if there are some errors it returns a 'false'	       if(ValidateBoxes())       { 	//if all the Fields of the WinForm are valid then call the method 'DecryptData() ' 	//this method takes care of all the decrypting to do 	DecryptData(); 			 	//after decrypting set all the TextBoxes to their default values 	//this is not necessary but more user friendly... 	opent.Text=""; 	savet.Text="" ; 	passt.Text="" ; 	radioButton1.Checked=true ;       }     }     //This method is called when the 'Encrypt' button is pressed in the WinForm.     //It checks the file and encrypts it according to the algoritm specified by the user.     protected void encryptb_click(object sender, System.EventArgs e)     {       //a method 'ValidateBoxes()' is called which returns a true only if all the fields of the        //WinForm are properly filled        if(ValidateBoxes())       { 	//Here we make a call the a method 'GenerateKee(bool variable)'  	//this method takes in a bool value and generates the Hash 'Key' 	//and 'Initialization Vector' which will be used in encryption / decryption 	//it returns a 'true' if everything is properly generated 	//Here we Pass the 'radioButton1.Checked' as an argument since the method generates  	//'key' and 'vector' depending on which algorithm to use 	//so if 'radioButton1.Checked=true' it means we are using the 'DES' algorithm 	//else we are using the 'RC2' algorithm 	if(GenerateKee(radioButton1.Checked)) 	{ 	  //call the method 'EncryptData()' which will take care of all the encrypting 	  EncryptData() ; 				 	  //Set the TextBoxes to their default values 	  //this can be omitted , but its more user friendly 	  opent.Text=""; 	  savet.Text="" ; 	  passt.Text="" ; 	  radioButton1.Checked=true ; 	} 			       }     }      //This method is called when the 'Save' button is clicked     //	It opens a 'SaveFileDialog' and takes the file to be saved to     protected void saveb_click(object sender, System.EventArgs e)     {       //different parameters of the 'SaveFileDialog' are set here       saveFileDialog1.Filter = "All files (*.*)|*.* | Encryptor files (*.enc)|*.enc"  ;       saveFileDialog1.FilterIndex = 2 ;       saveFileDialog1.RestoreDirectory = true ;       //check if the user has already typed a file to save in the TextBox       if(savet.Text!="")       { 	//if the user has typed a filename in the TextBox then assign that  	//to the dialogs 'FileName' property 	saveFileDialog1.FileName=savet.Text ;       }       if(saveFileDialog1.ShowDialog() == DialogResult.OK)       {     	//when the user presses 'Ok' on the 'SaveFileDialog' then set the  	//text of the TextBox 'savet' to the file selected        	savet.Text = saveFileDialog1.FileName ;       }     }      //This method is called when the 'Open' button is clicked by the user     protected void openb_click(object sender, System.EventArgs e)     {       //Set the various properties of the 'OpenFileDialog'	       openFileDialog1.Filter = "Encryptor files (*.enc)|*.enc|All files (*.*)|*.*"  ;       openFileDialog1.FilterIndex = 2 ;       openFileDialog1.RestoreDirectory = true ;       //check if the user has already typed the file to open in the textbox       if(opent.Text!="")       { 	//Then assign the Dialog the Filename from the TextBox 	openFileDialog1.FileName = opent.Text ;       }       if(openFileDialog1.ShowDialog() == DialogResult.OK)       {     	//if the user presses 'Ok' in the 'OpenFileDialog' then assign the     	//file selected to the textbox         opent.Text = openFileDialog1.FileName ;       }     }     //this method checks if any of the TextBoxes are left empty by the user      //and it generates the error required     //it returns 'true' if all values are proper     private bool ValidateBoxes()     {       //check the 'Open' File textbox	       if(opent.Text=="")       { 	MessageBox.Show("Please Enter the file to Encrypt / Decrypt !") ; 	return false ;       }       //check the 'Save' file textbox       if(savet.Text=="")       { 	MessageBox.Show("Please Enter the filename to save !") ; 	return false ;       }       //check the password textbox       if(passt.Text=="")       { 	MessageBox.Show("Please Enter the Password Encrypt / Decrypt your file with.") ; 	return false ;       }       //if everything is alright return true       return true ;     }      //This Method computes the 'Key' and the 'Vector' to be used in encrypting / decrypting.     //It generates the key according to the algorithm.     //It returns is key generation is successful      //	If the algorithm to be used is 'DES' then it generates a 64bit Key and 64bit Vector     //from the provided 'Password' .Then this is stored in to a 'byte' array having length '8'.      //since 1 byte = 8 bits , hence a byte array having length '8' will contain a key of     //8 x 8 =64 bits.     //We use a 64bit key since DES supports a minimum 64 bit key     //	If the algorithm to be used is 'RC2' then it generates a 40bit Key and a 40 bit Vector     //from the provided 'Password'.     //We use a 40 bit key here since RC2 supports a minimum 40 bit key      //(it does not support a 64bit key).     private bool GenerateKee(bool isDES)     {       //try-catch block       try       { 	//store the password in a string  	string pass =passt.Text ; 	int i ; 	int len ; 	//convert the password in to a Char array 	char[] cp = pass.ToCharArray() ; 	len = cp.GetLength(0) ; 	//initialize a byte array  	byte[] bt = new byte[len] ; 	//convert the Char array of the Password to a byte array 	for(i=0 ; i//if we are producing a Key-Vector for the 'DES' algorithm 	if(isDES) 	{ 	  //initialize the byte arrays which will contain the 'Key' and the 'Vector'  	  //to a length of '8' (see above why we use a array of length '8') 	  symKey=new byte[8] ; 	  symIV = new byte[8] ; 	  //make a instance of the class 'SHA1_CSP()'  	  //this class is useful in converting 'byte' into 'Hash'.			 	  SHA1_CSP sha = new SHA1_CSP() ; 	  //write the Hash of the byte array containing the password 	  sha.Write(bt) ; 	  //close the stream 	  sha.CloseStream() ; 	  //now Initialize the 'Key' array with the lower 64bits of the Hash of   	  //the 'Password' provided by the user 	  for(i=0 ; i<8 color="#0000ff">//initialize the 'Vector' array with the higher 64 bits of Hash of the  	  //'Password' provided by the user 	  for(i=8 ; i<16 color="#0000ff">//if the algorithm is 'RC2' then generate the following Key 	  //initialize the Key and Vector arrays to a length of '5' (see above why we use '5')  	  symKey=new byte[5] ; 	  symIV = new byte[5] ; 	  //make a instance of the class 'SHA1_CSP'  	  //this class writes the hash of a given byte			 	  SHA1_CSP sha = new SHA1_CSP() ; 	  //write the Hash of the byte array containing the user password 	  sha.Write(bt) ; 	  //close the stream 	  sha.CloseStream() ; 	  //now Initialize the Key array to lower 40 bits of the Hash of the 'Password'. 	  for(i=0 ; i<5 color="#0000ff">//initilize the Vector array to 40bits of hash  	  for(i=5 ; i<10 color="#0000ff">//since every thing went properly return 'true' 	return true ;	       }       catch(Exception e)       { 	MessageBox.Show("A Exception Occured in Generating Keys :"+e.ToString()) ; 	//return false since there was a error 	return false ;       }     }     //This method encrypts the given input file in either of the 2 algorithms 'DES' or 'RC2'.     //Then it writes out the encrypted file     //This method first reads the input file to check to see if its already encrypted by this     //same program. If its already encrypted it gives a error.     //According to the algorithm specified it then encrypts the file.     //Also in the first 8 bytes of the new Encrypted it writes out "[saudes]" or "[saurc2]"     //This is done so the while decrypting the program can know which algorithm was used to     //	encrypt the file. Also it used to check if the file has already encrypted     private void EncryptData()     {       //try-catch block       try       {	 	bool algo ;  //a boolean variable to check which algorithm to use in encrypting 	//open the 'FileStream' on the file to be encrypted 	FileStream fin = new FileStream(opent.Text , FileMode.Open , FileAccess.Read) ; 	//Make a file to save the encrypted data to and open a 'FileStream' on it 	FileStream fout = new FileStream(savet.Text , FileMode.OpenOrCreate , FileAccess.Write); 	//set the position of the 'cursor' to the start of the file 	fout.SetLength(0) ; 	//make a byte array of the size 64 bits 	//this is called the 'Buffer Size' of the algorithm 	//i.e. while encrypting blocks of the size 64bits are processed at a single time 	//later other blocks are of the same size. 	//we use 64bits because both 'DES' and 'RC2' both algorithms have 64 bit 'Buffer Size' 	byte[] bin = new byte[4096] ; 	//set the total length of the file to me encrypted to a variable  	long totlen = fin.Length ; 	long rdlen=0; 	int len ; 	//the code below is used to check if the file has already been encrypted  	//make a byte array of length '4'  	byte[] tag = new byte[4]; 	//read the first 4 bytes from the file to be encrypted         fin.Read(tag,0,tag.Length);         //if it contains the chars "[sau" then it has been already encrypted by this program         if ((tag[0]==(byte)'[')&&(tag[1]==(byte)'S')&&(tag[2]==(byte)'a')&&(tag[3]==(byte)'u'))         {           //generate a error to let the user know of the error           MessageBox.Show("This file is already Encrypted or in Invalid format!") ;           statusBar1.Text="Error - Invalid File Format !!"  ;                        }         else {           //if the file if ok the proceed with encryption           statusBar1.Text="Encrypting...";           //set the file read cursor back to the 'Beginning' of the opened file            fin.Seek(0, SeekOrigin.Begin);         } 	//make a object of the class 'SymmetricAlgorithm' 	SymmetricAlgorithm des ;         if(radioButton1.Checked)         {           //if the algorithm to be used is 'DES' then initialize the 'SymmetricAlgorithm'  	  //to 'DES_CSP'           des = new DES_CSP();           //set the variable to true because we are using 'DES' algorithm.           algo=true ;         }         else         {           //if the algorithm to be used is 'RC2' then initialize the variable 'des'  	  //to 'RC2_CSP'           des=new RC2_CSP() ;           //set the key size of the algorithm to 40 bits since we are using a 40 bit key           des.KeySize=40 ;           //uncomment the below code to find out the bits of keys supported by RC2 algorithm             	           /*KeySizes[] ks = des.LegalKeySizes ;           Console.WriteLine("Key Sizes Supported :") ;           Console.WriteLine("Minimum Size:" +ks[0].MinSize) ;           Console.WriteLine("Skip size of key: "+ks[0].SkipSize) ;           Console.WriteLine("Maximum Size: "+ks[0].MaxSize) ;           */             	           //set the bool variable to false since we are using the RC2 algorithm           algo=false ;                }         //Make a object of the inner class 'StoreCryptoStream' we pass the bool variable         //containing the algorithm information and the FileStream          StoreCryptoStream scs = new StoreCryptoStream(algo,fout);         //make an object of the 'SymmetricStreamEncryptor' class and pass it the          //'Key' and the 'Vector' this stream helps to encrypt data according to the algorithm         SymmetricStreamEncryptor sse = des.CreateEncryptor(symKey, symIV);         // a little extra feature here to show how to compose crypto          // components that support ICryptoStream         SHA1_CSP sha = new SHA1_CSP();         // wire up the encryptor - hash - StoreCryptoStream         sse.SetSink(sha);	         sha.SetSource(sse);         sha.SetSink(scs);	         scs.SetSource(sha);         //read from the file to encrypt          while (rdlen < color="#0000ff">//set the number of bytes read           len = fin.Read(bin,0,4096);           //write the encrypted data           sse.Write(bin,0,len);           //increase the size of bytes read           rdlen = rdlen + len;         }         //free up the resources         sse.CloseStream();         fin.Close(); 	fout.Close() ; 	statusBar1.Text="Encryption Compelete !" ;       }       catch(Exception e)       { 	MessageBox.Show("An exception occured while encrypting :"+e.ToString()) ; 	statusBar1.Text="Error" ;       }     }     //This method decrypts the given input file in either of the 2 algorithms 'DES' or 'RC2'.     //Then it writes out the decrypted file     //This method first reads the input file to check to see if its encrypted by which     //algorithm. then it automatically decrypts the file.      //It reads the first 8 bytes of the encrypted file to find the custom tag that we place     //while encrypting.     //If it finds "[saudes]" it uses the 'DES' algorithm to decrypt     //If it finds "[saurc2]" it uses the 'RC2' algorithm to decrypt     private void DecryptData()     {       //try-catch block       try       { 	statusBar1.Text="Decrypting...." ; 	//open file streams to the input and outfiles  	FileStream fin = new FileStream(opent.Text , FileMode.Open , FileAccess.Read) ; 	FileStream fout = new FileStream(savet.Text ,FileMode.OpenOrCreate ,FileAccess.Write); 	fout.SetLength(0) ; 	//a variable to check the validity of the input file 	bool filecheck = false ; 	//make a byte array of the size 64 bits 	//this is called the 'Buffer Size' of the algorithm 	//i.e. while encrypting blocks of the size 64bits are processed at a single time 	//later other blocks are of the same size. 	//we use 64bits because both 'DES' and 'RC2' both algorithms have 64 bit 'Buffer Size'         byte[] bin = new byte[4096] ; 	long totlen = fin.Length ; 	long rdlen=8; 	int len ; 	// declare a object of type 'SymmetricAlgorithm' 	SymmetricAlgorithm des ; 	//set a temporary variable to length '8' (we use '8' since the size of  	//the tag put in the file is 8) 	byte[] tag = new byte[8]; 	//read the first 8 bytes from the input file to check which algorithm is used to  	//encrypt the file         fin.Read(tag,0,tag.Length);         if ((tag[0]==(byte)'[')&&(tag[1]==(byte)'S')&&(tag[2]==(byte)'a')&&(tag[3]==(byte)'u') 	 &&(tag[4]==(byte)'d')&&(tag[5]==(byte)'e')&&(tag[6]==(byte)'s')&&(tag[7]==(byte)']'))  	{ 	  //If this is true then the 'DES' algorithm has been used to encrypt the file 	  //so set the variable 'des' to new 'DES_CSP'  	  des = new DES_CSP() ; 	  //set the variable to true since the file is encrypted 	  filecheck=true ; 	  //generate the Key and Vector from the given password 	  //we send 'true' here since the algorithm used is 'DES'  	  GenerateKee(true) ; 	} 	else if((tag[0]==(byte)'[')&&(tag[1]==(byte)'S')&&(tag[2]==(byte)'a') 	&&(tag[3]==(byte)'u')&&(tag[4]==(byte)'r')&&(tag[5]==(byte)'c') 	&&(tag[6]==(byte)'2')&&(tag[7]==(byte)']'))  	{ 	  //if this is true then the 'RC2' algorithm has been used to encrypt the file 	  //so we set the variable 'des' to new 'RC2_CSP' 	  des = new RC2_CSP() ; 	  //set the keysize of the algorithm 	  des.KeySize=40 ; 	  //set the variable to true since it is encrypted 	  filecheck=true ; 	  //generate the Key and Vector from the password given by the user 	  //we pass false here since we are using 'RC2' algorithm  	  GenerateKee(false) ; 	} 	else  	{ 	  MessageBox.Show("File Error !! File is not encrypted by SymEncryptor !!") ; 	  //set the des to null so no encryption occurs 	  des=null ; 	  statusBar1.Text="Error "; 	} 	//if the file is encrypted then decrypt it 	if(filecheck){ 	  //create a object of the inner class 'StoreCryptoStream'  	  //we pass it the FileStream 	  StoreCryptoStream scs = new StoreCryptoStream(fout); 	  //make a object of this stream passing the Key and Vector 	  //we use this stream since it helps us decrypt data from a 	  //encrypted file 	  SymmetricStreamDecryptor ssd = des.CreateDecryptor(symKey, symIV);           //set up the streams           ssd.SetSink(scs);           scs.SetSource(ssd);           //read the full encrypted file and decrypt           while (rdlen < color="#0000ff">//set the length of the number of bytes read             len = fin.Read(bin,0,4096);             //write the decrypted data              ssd.Write(bin,0,len);             //increase the total read bytes variable             rdlen = rdlen + len;           }           //free up the resources           ssd.CloseStream(); 	} 	fin.Close(); 	fout.Close(); 	statusBar1.Text="Decryption Compelete" ;       }       catch(Exception e)       { 	MessageBox.Show("An exception occured while decrypting :"+e.ToString()) ; 	statusBar1.Text="Error" ;       }	     }      //This is a inner class which Implements the 'ICryptoStream' interface     //we write this class so that it will provide us with a custom stream     //which will write and read the way we want it to     public class StoreCryptoStream : ICryptoStream     {       //two byte arrays containing the bytes to be written while encrypting       static byte[] tag1 = {(byte)'[',(byte)'S',(byte)'a',(byte)'u' ,(byte)'d'  				,(byte)'e',(byte)'s' ,(byte)']'};       static byte[] tag2=  {(byte)'[',(byte)'S',(byte)'a',(byte)'u' ,(byte)'r'  				,(byte)'c',(byte)'2' ,(byte)']'};        FileStream fs;       //This is the constructor of this class       //it takes 2 parameters       //1)a bool varable to indicate which algorithm has called it       //if it 'true' then 'DES' has called it , if its 'false' then        //'RC2' has called it.       //2)the FileStream to the output file       public StoreCryptoStream(bool algo, FileStream fout)        {         fs = fout;         if (algo){          //we are here since the variable 'algo' is 'true' indicating that 'DES' algorithm  	 //is being used          //hence it writes the byte array 'tag1' to the output file           fs.Write(tag1,0,8);         }         else         {           //we are here since the variable 'algo' is 'false' indicating that 'RC2'algorithm  	  //is being used           //hence it writes the byte array 'tag2' to the output file         	  fs.Write(tag2,0,8) ;         }       }     //This is another constructor which takes one parameter "FileStream"     //It is called from the decrypting method     public StoreCryptoStream(FileStream fout)     {       fs=fout ;     }          //other methods which have to be implemented     public virtual void CloseStream() {fs.Close();}     public virtual void CloseStream(Object obj) {fs.Close();}     public virtual void SetSink(ICryptoStream pstm) {}     public virtual void  SetSource(CryptographicObject co) {}     public virtual ICryptoStream  GetSink () {return null;}              // Write routines just copy output to the target file     public virtual void Write(byte[] bin)     {         int len = bin.GetLength(0);         Write(bin, 0, len);     }          public virtual void Write(byte[] bin, int start, int len )     {         fs.Write(bin,start,len);     }   }//StoreCryptoStream class  }//SymEncryptor class }

C# - The Ping Utility

2008-10-23T03:25:00.000-07:00

Welcome to Learn C# - the easy way , by Saurabh Nandu.

Ping is a very useful utility used to determine the speed of a Network Connection. It establishes a socket connection with the given hostname and sends a Data Packet using ICMP Protocol. The Host then in reply send back a Packet. The time taken to Send and Receive a Data Packet is calculated in Milliseconds. This helps us to know the speed of the connection.

Usage:
Ping /r
where :
- is the Host Address of the Server to Ping
/r - Optional Switch to ping continuously to the HostName

Code:
1) Ping.cs :- The Ping Utility

namespace SaurabhPing {   using System;   using System.Net;   using System.Net.Sockets;   ///    ///		The Main Ping Class   ///    class Ping   {     //Declare some Constant Variables     const int SOCKET_ERROR = -1;             const int ICMP_ECHO = 8;     ///      ///		The Starting Point of the Class     ///		It Takes the Hostname parameter     ///      public static void Main(string[] argv)     {       if(argv.Length==0)       { 	//If user did not enter any Parameter inform him 	Console.WriteLine("Usage:Ping  /r") ; 	Console.WriteLine(" The name of the Host who you want to ping"); 	Console.WriteLine("/r Ping the host continuously") ;       }       else if(argv.Length==1)       { 	//Just the hostname provided by the user 	//call the method "PingHost" and pass the HostName as a parameter 	PingHost(argv[0]) ;       }       else if(argv.Length==2)       { 	//the user provided the hostname and the switch 	if(argv[1]=="/r") 	{ 	  //loop the ping program 	  while(true) 	  { 		//call the method "PingHost" and pass the HostName as a parameter 		PingHost(argv[0]) ; 	  }         } 	else 	{ 	  //if the user provided some other switch 	  PingHost(argv[0]) ; 	 }        }        else        { 	 //Some error occurred 	 Console.WriteLine("Error in Arguments") ;         }      } 		       ///        ///		This method takes the "hostname" of the server       ///		and then it ping's it and shows the response time       ///        public static void PingHost(string host)       { 	//Declare the IPHostEntry  	IPHostEntry serverHE, fromHE; 	int nBytes = 0; 	int dwStart = 0, dwStop = 0; 	//Initilize a Socket of the Type ICMP 	Socket socket =  	new Socket(AddressFamily.AfINet, SocketType.SockRaw, ProtocolType.ProtICMP); 	 	// Get the server endpoint 	try 	{ 	  serverHE = DNS.GetHostByName(host);	 	} 	catch(Exception) 	{ 	  Console.WriteLine("Host not found"); // fail 	  return ; 	}  	// Convert the server IP_EndPoint to an EndPoint 	IPEndPoint ipepServer = new IPEndPoint(serverHE.AddressList[0], 0); 	EndPoint epServer = (ipepServer);	  	// Set the receiving endpoint to the client machine 	fromHE = DNS.GetHostByName(DNS.GetHostName()); 	IPEndPoint ipEndPointFrom = new IPEndPoint(fromHE.AddressList[0], 0);         	EndPoint EndPointFrom = (ipEndPointFrom);  	int PacketSize = 0; 	IcmpPacket packet = new IcmpPacket(); 	// Construct the packet to send 	packet.Type = ICMP_ECHO; //8 	packet.SubCode = 0; 	packet.CheckSum = UInt16.Parse("0"); 	packet.Identifier   = UInt16.Parse("45");  	packet.SequenceNumber  = UInt16.Parse("0");  	int PingData = 32; // sizeof(IcmpPacket) - 8; 	packet.Data = new Byte[PingData]; 	//Initilize the Packet.Data 	for (int i = 0; i < color="#0000cc">//Variable to hold the total Packet size 	PacketSize = PingData + 8; 	Byte [] icmp_pkt_buffer = new Byte[ PacketSize ];  	Int32 Index = 0; 	//Call a Method Serialize which counts 	//The total number of Bytes in the Packet 	Index = Serialize(   	                  packet,  	                 icmp_pkt_buffer,  	                  PacketSize,  	                   PingData ); 	//Error in Packet Size 	if( Index == -1 ) 	{ 	  Console.WriteLine("Error in Making Packet"); 	  return ; 	}            	// now get this critter into a UInt16 array 	          	//Get the Half size of the Packet 	Double double_length = Convert.ToDouble(Index); 	Double dtemp = Math.Ceil( double_length / 2); 	int cksum_buffer_length = Convert.ToInt32(dtemp); 	//Create a Byte Array 	UInt16 [] cksum_buffer = new UInt16[cksum_buffer_length]; 	//Code to initialize the Uint16 array  	int icmp_header_buffer_index = 0; 	for( int i = 0; i < color="#0000cc">//Call a method which will return a checksum              	UInt16 u_cksum = checksum(cksum_buffer, cksum_buffer_length); 	//Save the checksum to the Packet 	packet.CheckSum  = u_cksum;  	             	// Now that we have the checksum, serialize the packet again 	Byte [] sendbuf = new Byte[ PacketSize ];  	//again check the packet size 	Index = Serialize(   	                  packet,  	                  sendbuf,  	                  PacketSize,  	                  PingData ); 	//if there is a error report it 	if( Index == -1 ) 	{ 	  Console.WriteLine("Error in Making Packet"); 	  return ; 	} 	                  	dwStart = System.Environment.TickCount; // Start timing 	//send the Pack over the socket 	if ((nBytes = socket.SendTo(sendbuf, PacketSize, 0, epServer)) == SOCKET_ERROR)  	{		 	  Console.WriteLine("Socket Error cannot Send Packet"); 	} 	// Initialize the buffers. The receive buffer is the size of the 	// ICMP header plus the IP header (20 bytes) 	Byte [] ReceiveBuffer = new Byte[256];  	nBytes = 0; 	//Receive the bytes 	bool recd =false ; 	int timeout=0 ;   	//loop for checking the time of the server responding  	while(!recd) 	{ 	  nBytes = socket.ReceiveFrom(ReceiveBuffer, 256, 0, ref EndPointFrom); 	  if (nBytes == SOCKET_ERROR)  	  { 	    Console.WriteLine("Host not Responding") ; 	    recd=true ; 	    break; 	  } 	  else if(nBytes>0) 	  { 	    dwStop = System.Environment.TickCount - dwStart; // stop timing 	    Console.WriteLine("Reply from "+epServer.ToString()+" in " 		+dwStop+"MS :Bytes Received"+nBytes); 	    recd=true; 	    break; 	  } 	  timeout=System.Environment.TickCount - dwStart; 	  if(timeout>1000) 	  { 	    Console.WriteLine("Time Out") ; 	    recd=true; 	  }         } 	             	//close the socket 	socket.Close();            }       ///        ///  This method get the Packet and calculates the total size        ///  of the Pack by converting it to byte array       ///        public static Int32 Serialize(IcmpPacket packet, Byte[] Buffer, 			Int32 PacketSize, Int32 PingData )       { 	Int32 cbReturn = 0; 	// serialize the struct into the array 	int Index=0;  	Byte [] b_type = new Byte[1]; 	b_type[0] = (packet.Type);  	Byte [] b_code = new Byte[1]; 	b_code[0] = (packet.SubCode);  	Byte [] b_cksum = BitConverter.GetBytes(packet.CheckSum); 	Byte [] b_id = BitConverter.GetBytes(packet.Identifier); 	Byte [] b_seq = BitConverter.GetBytes(packet.SequenceNumber); 	         	// Console.WriteLine("Serialize type "); 	Array.Copy( b_type, 0, Buffer, Index, b_type.Length ); 	Index += b_type.Length; 	         	// Console.WriteLine("Serialize code "); 	Array.Copy( b_code, 0, Buffer, Index, b_code.Length ); 	Index += b_code.Length;  	// Console.WriteLine("Serialize cksum "); 	Array.Copy( b_cksum, 0, Buffer, Index, b_cksum.Length ); 	Index += b_cksum.Length;  	// Console.WriteLine("Serialize id "); 	Array.Copy( b_id, 0, Buffer, Index, b_id.Length ); 	Index += b_id.Length;  	Array.Copy( b_seq, 0, Buffer, Index, b_seq.Length ); 	Index += b_seq.Length;  	// copy the data	         	Array.Copy( packet.Data, 0, Buffer, Index, PingData ); 	Index += PingData; 	if( Index != PacketSize/* sizeof(IcmpPacket)  */) { 	  cbReturn = -1; 	  return cbReturn; 	}  	cbReturn = Index; 	return cbReturn;       }       ///        ///		This Method has the algorithm to make a checksum        ///        public static UInt16 checksum( UInt16[] buffer, int size )       { 	Int32 cksum = 0; 	int counter;  	counter = 0;  	while ( size > 0 ) {           UInt16 val = buffer[counter];  	  cksum += Convert.ToInt32( buffer[counter] ); 	  counter += 1; 	  size -= 1; 	}  	cksum = (cksum >> 16) + (cksum & 0xffff); 	cksum += (cksum >> 16); 	return (UInt16)(~cksum);       }     } // class ping     ///      ///		Class that holds the Pack information     ///      public class IcmpPacket      {         public Byte  Type;    // type of message        public Byte  SubCode;    // type of sub code        public UInt16 CheckSum;   // ones complement checksum of struct        public UInt16 Identifier;      // identifier        public UInt16 SequenceNumber;     // sequence number          public Byte [] Data;       } // class IcmpPacket }

SDI,MDI, Views, MFC, Doc View Architecture, threading applications

2008-09-15T05:41:00.000-07:00

SDI/Splitter Window/MDIA simple splitter window example Dynamic splitter window An MDI application Opening different types of documents in MDI applicationShellDisplaying icon in the system tray Using Shell File OperationThreadsCreating and closing threads programmatically
Displaying list of processes running in the system
Worker Thread User Interface Thread Thread Synchronization Using Mutex Threads Synchronization Using Events Using Critical Section More On User Interface ThreadViewsWindows Explorer like application Sorting items of a list view control on clicking on the column
Creating Wordpad like application using Rich Edit view A Scroll view application Creating a Browser

Visual C++ Projects

2008-09-15T05:39:00.000-07:00

File I/OSorting the text file
Joker
File Properties
DiskFull Disk informationGDIRotating Text Creating cliparts Marquee rectangle Bow and Arrow Rolling Your Own Mapping Modes
Gradient FillHelpCreating HTML help systemInternetBrowser application FTP Explorer MAPI File Operations Using HTTP File Operations Using FTP Internet Programming - Using FTP
Using ISAPI Extension DLL Accessing Database Using ISAPIKeyboardRecognizing which shift/toggle key is pressed Toggle Num Lock, Caps Lock and Scroll Lock keys programatically ShuffleMenuOwnerdrawn menu with colored lines Ownerdrawn menu with bitmaps Attaching menu items to the system menuMouseDisplaying mouse coordinates in status bar Memory game Tic Tac ToeOpenGlDrawing simple shapes Coloured cube Screen SaverPalettePalette demo Palette Animation How Windows Uses ColorsPrintingA Sample Printing Application Printing a text fileRegistryA program that runs only for limited hours Tip Of The Day
Screen SaverCreating a simple screen saver
MiscellaneousBalloon tooltip Hiding window button from task bar Changing shape of a window Adding Splash Screen component
Adding Multimedia component MCIWnd Rect Tracker Creating Control Panel Applet Converting a number to words Hardware Information Hardware Information Windows Hook XOR Encryptor

Dlls - Dynamic link library projects

2008-09-15T05:38:00.000-07:00

DLLRegular DLL Extension DLL Implicit/Explicit linking
extern "C"

Network programming

2008-09-15T05:37:00.000-07:00

NetworkEnumerating Network Resources Remote Shutdown

Socket Programming

2008-09-15T05:36:00.002-07:00

Socket ProgrammingChat Server Through Socket Programming (
Multiple Clients Chat Server

Dialog box

2008-09-15T05:36:00.001-07:00

Dialog

Talking Calculator

HTML - DHTML

2008-09-15T05:35:00.001-07:00

DHTMLClock

Database

2008-09-15T05:34:00.000-07:00

DatabaseODBC
DAO
Interacting With Excel Spreadsheet- Using ODBC

Windows Controls

2008-09-15T05:33:00.000-07:00

ControlsCreating a non-rectangular button Creating a transparent edit box
Creating ownerdrawn list box
Creating ownerdrawn combo box
Directory-Tree control with Checkboxes
Printing List View Control Contents Sorting List Control Items OLE Drag And Drop Implementing Drag And Drop On Tree Items Displaying Controls in List Control

C++ Projects

2008-09-15T05:32:00.000-07:00

C++Elementary database management The string class (Tips about templates
Causes of memory leaks Timer class
Customer Information System Jeeto Chappar Phaade Ke Kaun Banega Crorepati Hangman
Calendar cum Schedular
Graphics Editor Bump Mapping File Split and Join
Developing GUIs in C++ - I
Developing GUIs in C++ - II

ActiveX Data Object

2008-09-15T05:31:00.000-07:00

ADO

	ActiveX Data Object

Visual C#.Net Code - Reflection

2008-08-24T22:25:00.000-07:00

click here to download project

VC++ Code - Printing text files

2008-08-24T22:08:00.001-07:00

click here to download project

VC++ code - Dlls - dynamic and static linking

2008-08-24T22:07:00.001-07:00

click here to download project

VC++ Code - Extenstion Dll

2008-08-24T22:06:00.001-07:00

click here to download projct

VC++ Code - Regular Dll

2008-08-24T22:05:00.000-07:00

click here to download project

Visual C++ Code - Chat Server using Socket programming

2008-08-24T22:03:00.000-07:00

Click here to download project

C source code for 2 Linked List Implementation Of Stack

2008-08-05T00:25:00.002-07:00

#define TRUE 1

# define FALSE 0

typedef struct stack_element {

int stack_data;

struct stack_element *next;

}stack_inf;

typedef struct stack_element_top{

stack_inf *stack_top;

}stack;

stack *create()

{

stack *s;

s=(stack *)malloc(sizeof(stack));

s->stack_top=NULL;

return(s);

}

int isempty (stack *s)

{

if (s->stack_top == NULL)

return TRUE;

else

return FALSE;

}

void push (stack *s,int x)

{

stack_inf *p;

p=(stack_inf *)malloc(sizeof(stack_inf));

p->stack_data=x;

p->next=NULL;

if(isempty(s))

s->stack_top=p;

else

{

p->next=s->stack_top;

s->stack_top=p;

}

return;

}

int pop(stack *s)

{

stack_inf *p;

int x;

if(isempty(s))

printf(“\nStack is empty !\n”);

else

{

p=s->stack_top;

x=p->stack_data;

s->stack_top=p->next;

free(p);

return(x);

}

C source code for An array implementation of the operations of a stack ADT

2008-08-05T00:25:00.001-07:00

#define MAX 1000 /* only 1000 elements can be stored in the stack*/

# define TRUE 1

# define FALSE 0

typedef int stack_data;

struct stack_inf{

int top;

stack_data stack_elements[MAX];

};

typedef struct stack_inf stack;

stack s;

void create(stack *s)

{

s->top=-1;

return;

}

int isempty (stack *s)

{

if (s->top == -1)

return(TRUE);

else

return(FALSE);

}

int isfull (stack *s)

{

if (s->top == (MAX -1))

return(TRUE);

else

return(FALSE);

}

stack_data pop (stack *s)

{

int t;

stack_data ret;

if (isempty(s))

printf(“The stack is empty\n”);

else

{

t = s->top;

ret=s->stack_elements[t];

s->top - -;

}

return(ret);

}

void push (stack *s, stack_data x)

{

if (isfull(s))

printf(“Stack is FULL ! No insertion possible\n”);

else

{

++s->top;

s->stack_elements[s->top]=x;

}

C Source code for Implementation of queue using Linked Lists

2008-08-03T23:30:00.001-07:00

#define TRUE 1

#define FALSE 0

struct queue_element{

int data;

struct queue_element *next;

};

typedef struct queue_element queue_info;

typedef struct qpointer{

queue_info *front, *rear;

}queue;

queue *q;

queue *create()

{

queue *p;

p=(queue *)malloc(sizeof(queue));

p->front=NULL;

p->rear=NULL;

return(p);

}

int isempty(queue *q)

{

if(q->front == NULL)

return(TRUE);

else

return(FALSE);

}

void insert_queue (queue *q,int item)

{

queue_info *new;

new=(queue_info *) malloc (sizeof (queue_info));

new->next = NULL;

new->data = item;

if (isempty(q))

{

q->front = new;

q->rear = new;

}

else

{

q->rear->next=new;

q->rear=new;

}

return;

}

int delete_queue(queue *q)

{

int item;

queue_info *del;

if (isempty(q))

{

printf(“Queue is empty ! \n”);

return(-1);

}

else

{

del=q->front;

q->front=q->front->next;

item=del->data;

free (del);

if(q->front == NULL)

q->rear=NULL;

return(item);

}

C Source code for Implementation of queue using Stacks

2008-08-03T23:29:00.000-07:00

# include

#define MAX 5

#define TRUE 1

#define FALSE 0

#define ERROR -1

struct qinfo{

int front,rear;

int noele;

int qelement[MAX];

};

typedef struct qinfo queue;

void create(),insert_queue();

int isfull(),isfull(),delete_queue();

void create(queue *q)

{

q->front=-1;

q->rear=-1;

q->noele=0;

return;

}

int isempty(queue *q)

{

if(q->noele == 0)

return(TRUE);

else

return(FALSE);

}

int isfull(queue *q)

{

if(q->noele == MAX)

return(TRUE);

else

return(FALSE);

}

void insert_queue(queue *q,int item)

{

char stop;

if(isfull(q))

printf("Queue is full \n");

else

{

if(isempty(q))

{

create(q);

q->front++;

q->rear++;

}

else

if(q->rear < (MAX - 1) || q->rear < (q->front - 1))

q->rear++;

else

if(q->rear == (MAX - 1) && q->noele <>

q->rear=0;

q->qelement[q->rear]=item;

q->noele++;

}

return;

}

int delete_queue(queue *q)

{

int data;

if(isempty(q))

{

printf("Queue is empty!!!\n");

return(ERROR);

}

else

{

data=q->qelement[q->front];

if(q->front == (MAX - 1))

q->front=0;

else

q->front++;

q->noele--;

if(isempty(q))

create(q);

return(data);

}

C Code for Removing duplicate nodes from linked list

2008-08-02T20:31:00.000-07:00

void RemoveDuplicates ( NODE**head) {

NODE *pCurrent = *head;

if(pCurrent ==NULL)
return;
else {
while(pCurrent ->next !=NULL) {

if(pCurrent ->data == pCurrent ->next->data) {

NODE *nnext = pCurrent ->next->next;
free(pCurrent ->next);
pCurrent ->next = nnext;
}
else
pCurrent =pCurrent ->next;
}
}
}

C Code for Mirror Image Tree

2008-08-02T20:28:00.000-07:00

void mirror(struct node* node) {

if (node==NULL) {

return;
}
else {

struct node* temp; // do the subtrees
mirror(node->left); mirror(node->right); // swap the pointers in this node
temp = node->left;
node->left = node->right;
node->right = temp;
}
}

C Code for Heapsort algorithm

2008-07-31T22:15:00.000-07:00

heapsort(x,n)

int x[],n;

{

int i,data,s,f,ivalue;

/* create initial heap */

for(i=1;i <>

{

data=x[i];

/* insert_heap (x,i,data); */

s=i;

f=(s - 1) / 2; /* f is the father of s */

while(s > 0 && x[f] <>

{

x[s]=x[f]; /* move up the tree */

s=f;

f=(s - 1) / 2; /* f is the father of s */

}/* end while */

x[s]=data;

}/* end for i.e. a heap has been created */

/* begin repeatedly removing the maximum element i.e. x[0], */

/* place it at the end of the array.*/

/* Convert the remaining part to a heap */

for(i=n - 1; i > 0;i--)

{

/* delete the root */

ivalue=x[i];

x[i]=x[0]; /* the root is placed at the bottom */

f=0;

/* begin adjusting the heap by pushing the element x[i] i.e. ivalue */

if(i == 1)

s=-1;/* no further processing required */

else

s=1;

if(i > 2 && x[2] > x[1])

s=2;

while(s >=0 && ivalue <>

{

/* push ivalue down the heap */

x[f]=x[s];

f=s;

/* s=largeson(f, i-1) */

s=2*f +1; /* s is the child of f */

if(s+1 <= i-1 && x[s] <>

s=s+1; /* select the larger of the two children of f i.e. 2j + 1 or 2j + 2 */

if(s > i-1) /* when bounds have been reached */

s=-1;

}/* end while */

/* insert ivalue at fth location */

x[f]=ivalue;

}/* end for */

}/* end heap sort */

C code for NONRECURSIVE IMPLEMENTATION OF QUICKSORT

2008-07-31T22:06:00.001-07:00

# define STACKSIZE 50

void quicksort(int x[], int n)

{

int i,j;

struct stack_info{

int l;

int u;

}bounds;

struct stack_tag{

int stacktop;

struct stack_info limits[STACKSIZE];

}STACK;

STACK.stacktop=-1;

bounds.l=0;

bounds.u=n - 1;

push(&STACK,&bounds);

while(!empty(&STACK))

{

pop(&STACK,&bounds);

while(bounds.u > bounds.l)

{

partition(x,bounds.l,bounds.u,&j);

if((j - bounds.l) > (bounds.u - j))

{

i=bounds.u;

bounds.u=j - 1;

push(&STACK,&bounds);

bounds.l=j + 1;

bounds.u=i;

}

else

{

i=bounds.l;

bounds.l=j + 1;

push(&STACK,&bounds);

bounds.l=i;

bounds.u=j - 1;

} /* end if */

} /* end while */

}/* end while */

return;

} /* end quicksort */

int emtpy (struct stack_tag * stackptr)

{

if( stackptr->stack.top == -1)

return (1);

else

return (0);

} /* end empty*

void pop (struct stack_tag * stackptr, struct stack_info * data)

{

if empty (stackptr)

{

printf (“%s\n”, “stack underflow”);

}

data=&(stackptr-> limits [stackptr->stacktop]);

-- (stackptr->stacktop);

return;

}

void push (struct stack_tag * stackptr, struct stack_info *data)

{

int p;

p=++(stackptr->stacktop);

stackptr->limits[p].l = data->l;

stackptr->limits [p].u = data->u;

return;

} /*end push.; note no checking for stack overflow */

C code for A recursive implementation of the quicksort algorithm.

2008-07-31T22:05:00.000-07:00

void quicksort(int x[], int l, int u)

{

int * j; int k;

if (l > =u)

return;

else

{

partition (x, l,u,&j);

quicksort (x, l, j -1);

quicksort (x, j+1, u);

return;

}

void partition (int x [], int l, int u,int *j)

{

int k, m,n, i, temp, int * j;

k = x [l]; /* k is the element whose final */

n = u; /* position is required */

m =l;

while (m <>

{

while (x[m] <= k && m <>

m++ ; /* move the lower index up */

while (x[n] > k)

n --; /* reduce the upper index */

if (m

{

/*interchange x[m] & x[n] */

temp=x[m];

x[m]=x[n];

x[n]=temp;

} /* end if */

} * end while */

x[l]= x[n];

x[n]=k;

* j = n;

return;

}

C++ Source code for using STL unary_functions.

2008-07-30T01:11:00.000-07:00

#include "stdafx.h"

#include
#include
#include
#include // for remove_if
#include
#include
using namespace std;

template
class is_vowel : public unary_function {

public:
bool operator ()(T t) const
{
if ((t=='a')||(t=='e')||(t=='i')||(t=='o')||(t=='u'))
return true; //t is a vowel
return false; // t is not a vowel
}
};

bool greaterthan(int x) {

return x>6;
}
int main()
{

string original;
cout << "Type string to remove vowels." <<>> original;
//…

string::iterator it= remove_if(original.begin(),
original.end(),
is_vowel());

// create new string from original using previous iterator
string no_vowels(original.begin(),it);
cout <<<><< "Remove all numbers greater than 6" < v1;
v1.push_back(7);
v1.push_back(1);
v1.push_back(9);
v1.push_back(2);
v1.push_back(0);
v1.push_back(7);
v1.push_back(7);
v1.push_back(3);
v1.push_back(4);
v1.push_back(6);
v1.push_back(8);
v1.push_back(5);
v1.push_back(7);
v1.push_back(7);

for(vector::iterator itr_prn = v1.begin() ;itr_prn!= v1.end(); itr_prn++)
cout<<" "<< *itr_prn ; cout <::iterator itre = remove_if(v1.begin(),v1.end(),greaterthan);
vector::iterator itrb = v1.begin();

for(;itrb != itre; itrb++)
cout << " " << *itrb;

}

C Source code for reversing a singly linked list.

2008-07-30T00:57:00.001-07:00

void reverse(node **head) {

node *current = *head;
node *result = 0;
node *next;
while (current != 0) {

next = current->next;
current->next = result;
result = current;

current = next;
}
*head = result;
}

C Source code for checking if a number is power of 2

2008-07-30T00:40:00.000-07:00

void root( int & nn) {
nn = nn/2;
}

int PowerOf2() {

int n ;
char ch='q';

do {

printf("\nEnter No: ");
scanf("%d",&n);
if((n & n-1) == 0) {

int temp =n;
while(temp >0 && temp%2 ==0 ) {

printf(" %d *", temp);
root(temp);
}
}
else {

printf("\n No is not a power of 2.");
}
printf("\nDo you want to continue.... :");
scanf("%c", &ch);
}while(ch!='q');

return 0;
}

C source code for converting an integer to binary.

2008-07-28T22:00:00.001-07:00

char *int2bin(int a)
{
char *str,*tmp;
int cnt = 31;
str = (char *) malloc(33); /*32 + 1 , becoz its a 32 bit bin number*/
tmp = str;
while ( cnt > -1 ){
str[cnt]= '0';
cnt --;
}
cnt = 31; printf("\n");
while (a > 0){

if (a%2==1){
str[cnt] = '1';
printf(" 1");
}
else
printf(" 0");
cnt--;
a = a/2 ;
}
return tmp;

}

C Macro for verifying MSB

2008-07-28T21:59:00.000-07:00

#define zero_most_significant(h) \
(h&=(h>>1)|(h>>2), \
h|=(h>>2), \
h|=(h>>4), \
h|=(h>>8), \
h|=(h>>16))

C Macro Source Code for verifying if a number is power of two.

2008-07-28T21:56:00.000-07:00

#define power_of_two(x) ((x)&&(~(x&(x-1))))

C Source code for palindrome problem.

2008-07-28T05:23:00.001-07:00

struct ppair {
char c;
int first;
int last;
int num_inner_pairs;
ppair ** inner_pairs;
};

void add_to_inner( ppair * outer, ppair * inner) {

ppair ** temp;
int i;

temp = ( ppair * *)malloc((outer->num_inner_pairs + 1) * sizeof( ppair *));
for(i = 0; i <>num_inner_pairs; i++) {
temp[i] = outer->inner_pairs[i];
}
if (outer->num_inner_pairs > 0) {
free(outer->inner_pairs);
}
temp[outer->num_inner_pairs++] = inner;
outer->inner_pairs = temp;
}

void print_palendromes(const ppair * p, char * pre) {
int i;

printf("%s", pre); putc(p->c, stdout);
if (p->first <>last) {
putc(p->c, stdout);
}
for(i = strlen(pre); i > 0; i--) putc(pre[i-1], stdout);
printf("\n");

pre[strlen(pre)] = p->c;
for(i = 0; i <>num_inner_pairs; i++) {
print_palendromes(p->inner_pairs[i], pre);
}
pre[strlen(pre) - 1] = 0;
}

int pallindrome(int argc, const char ** argv) {
int i, j, k;
ppair g, * p;
char * buf;

if (argc != 2) {
fprintf(stderr, "usage: %s string\n", argv[0]);
return -1;
}

g.first = -1;
g.last = strlen(argv[1]);
g.num_inner_pairs = 0;

for(i = 0; i < strlen(argv[1]); i++) {
for(j = i; j < strlen(argv[1]); j++) {
if (argv[1][i] == argv[1][j]) {
ppair * p = ( ppair *)malloc(sizeof( ppair));
p->c = argv[1][i];
p->first = i;
p->last = j;
p->num_inner_pairs = 0;
for(k = 0; k < g.num_inner_pairs; k++) {
if (g.inner_pairs[k]->first <>last) {
add_to_inner(g.inner_pairs[k], p);
}
}
add_to_inner(&g, p);
}
}
}

buf = (char *)malloc(strlen(argv[1]) + 1);
memset(buf, 0, strlen(argv[1]) + 1);

for(k = 0; k < g.num_inner_pairs; k++) {
if (g.inner_pairs[k]->first <>last) {
print_palendromes(g.inner_pairs[k], buf);
}
}

for(k = 0; k < g.num_inner_pairs; k++) {
if (g.inner_pairs[k]->num_inner_pairs > 0) {
free(g.inner_pairs[k]->inner_pairs);
}
free(g.inner_pairs[k]);
}
free(g.inner_pairs);
free(buf);

return 0;
}

C Source code for multiplying two numbers without using multiplication operator.

2008-07-28T05:22:00.001-07:00

int multiply( int num, int num1) {

num = (num << 3) - num;
return num;
}

C Source code for counting 1's in a number.

2008-07-28T05:21:00.001-07:00

int bitcount (unsigned int n)
{
int count=0;
int counter =0;
while (n)
{
count += n & 0x1u ;
n >>= 1 ;
counter++;
}
return count ;
}

C Source code for converting from Integer to String - itoa implementation.

2008-07-28T05:18:00.000-07:00

void IntToStr( int num) {

bool bNegative =false;
if( num < 0)
bNegative =true;
char * str = new char[11];
int i =0;
while( num != 0) {

str[i++] = num % 10 + '0';
num /=10;
}
i--; int j =0;
while( j
char ch = str[j];
str[j] = str[i];
str[i] = ch;
j++; i--;
}

}

C Source Code for reversing a string.

2008-07-28T05:17:00.000-07:00

void ReverseString( char str[]) {

int start =0 ;int end = strlen(str)-1;
while(start < end) {

char ch = str[start];
str[start] = str[end];
str[end] = ch;

start++; end--;
}
}

C Source code for Converting from string to integer - atoi implementation

2008-07-28T05:16:00.000-07:00

int StrToInt( char str[]) {

bool bFlagNeative =false;
if( str[0] == '-') {

bFlagNeative =true;
}
int i=0;
int num =0;
while(str[i] != '\0') {

num *=10;
num+= (str[i++] - '0');
}
if(bFlagNeative)
num *= -1;
return num;

}

C Source code for reversing words in a string.

2008-07-28T05:15:00.000-07:00

bool reverseWords( char str[] ){
char *buffer;
int tokenReadPos, wordReadPos, wordEnd, writePos = 0;

/* Position of the last character is length - 1 */
tokenReadPos = strlen(str) - 1;

buffer = (char *) malloc(tokenReadPos + 2);
if( !buffer )
return false; /* reverseWords failed */

while( tokenReadPos >= 0 ){

if( str[tokenReadPos] == ' ' ){ /* Non-word characters */
/* Write character */
buffer[writePos++] = str[tokenReadPos--];

} else { /* Word characters */
/* Store position of end of word */
wordEnd = tokenReadPos;

/* Scan to next non-word character */
while( tokenReadPos >= 0 && str[tokenReadPos] != ' ' )
tokenReadPos--;

/* tokenReadPos went past the start of the word */
wordReadPos = tokenReadPos + 1;

/* Copy the characters of the word */
while( wordReadPos <= wordEnd ){
buffer[writePos++] = str[wordReadPos++];
}
}
}
/* null terminate buffer and copy over str */
buffer[writePos] = '\0';
strcpy(str, buffer);

free(buffer);

return true; /* ReverseWords successful */
}

Visual Basic Source code for AES Algorithm

2008-07-28T05:13:00.001-07:00

Private Const BlkLenMax = 32 ' maximum block length in bytes
Private Const KeyLenMax = 32 ' maximum block length in bytes
Private Const KeySchLenMax = 128 ' maximum key schedule length in bytes
Private BlkLen As Integer ' actual block length
Private KeyLen As Integer ' actual key length

Private Type AESctx ' Type to hold the AES context data
Ekey(0 To KeySchLenMax - 1) As Long
Nrnd As Long
Ncol As Long
End Type

Private Type KeyBlk ' Type to hold user key data
K(0 To KeyLenMax - 1) As Byte
End Type

Private Type IoBlk ' Type to hold cipher input and output blocks
IO(0 To BlkLenMax - 1) As Byte
End Type

Rem Change "d:\dll_pth" in the following lines to the directory path where the AES DLL is located
Private Declare Function AesBlkLen Lib "d:\dll_path\aes.dll" Alias "_aes_blk_len@8" (ByVal N As Long, C As AESctx) As Integer
Private Declare Function AesEncKey Lib "d:\dll_path\aes.dll" Alias "_aes_enc_key@12" (K As KeyBlk, ByVal N As Long, C As AESctx) As Integer
Private Declare Function AesDecKey Lib "d:\dll_path\aes.dll" Alias "_aes_dec_key@12" (K As KeyBlk, ByVal N As Long, C As AESctx) As Integer
Private Declare Function AesEncBlk Lib "d:\dll_path\aes.dll" Alias "_aes_enc_blk@12" (Ib As IoBlk, Ob As IoBlk, C As AESctx) As Integer
Private Declare Function AesDecBlk Lib "d:\dll_path\aes.dll" Alias "_aes_dec_blk@12" (Ib As IoBlk, Ob As IoBlk, C As AESctx) As Integer

Private Sub Hex(X As Byte) ' Output a byte in hexadecimal format
Dim H As Byte
H = Int(X / 16)
If H < 10 Then
Debug.Print Chr(48 + H);
Else
Debug.Print Chr(87 + H);
End If
H = Int(X Mod 16)
If H < 10 Then
Debug.Print Chr(48 + H);
Else
Debug.Print Chr(87 + H);
End If
End Sub

Private Sub OutKey(S As String, B As KeyBlk) ' Display a key value
Debug.Print: Debug.Print S;
For i = 0 To KeyLen - 1
Hex B.K(i)
Next i
End Sub

Private Sub OutBlock(S As String, B As IoBlk) ' Display an input/output block
Debug.Print: Debug.Print S;
For i = 0 To BlkLen - 1
Hex B.IO(i)
Next i
End Sub

Rem The following Main routine should output the following in the immediate window:
Rem Key = 00000000000000000000000000000000
Rem Input = 00000000000000000000000000000000
Rem Encrypted Text = 66e94bd4ef8a2c3b884cfa59ca342b2e
Rem Decrypted Text = 00000000000000000000000000000000

Sub Main()
Dim Key As KeyBlk ' These variables are automatically
Dim Ib As IoBlk, Ob As IoBlk, Rb As IoBlk
Dim Cx As AESctx ' initialised to zero values in VBA
Dim RetVal As Integer

BlkLen = 16: KeyLen = 16

Rem RetVal = AesBlkLen(BlkLen, Cx) ' include if the cipher block size is variable

OutKey "Key = ", Key
OutBlock "Input = ", Ib

RetVal = AesEncKey(Key, KeyLen, Cx) ' set an all zero encryption key
RetVal = AesEncBlk(Ib, Ob, Cx) ' encrypt Ib to Ob
OutBlock "Encrypted Text = ", Ob

RetVal = AesDecKey(Key, KeyLen, Cx) ' set an all zero decryption key
RetVal = AesDecBlk(Ob, Rb, Cx) ' decrypt Ob to Rb
OutBlock "Decrypted Text = ", Rb
Debug.Print

End Sub

Visual Basic for Applications code to illustrate the use of the AES Dynamic Link Library.

2008-07-28T05:10:00.000-07:00

Visual Basic for Applications code to illustrate the use of the AES Dynamic Link Library. Very similar code should also work in Visual Basic.

Private Const BlkLenMax = 32 ' maximum block length in bytes

Private Const KeyLenMax = 32 ' maximum block length in bytes

Private Const KeySchLenMax = 128 ' maximum key schedule length in bytes

Private BlkLen As Integer ' actual block length

Private KeyLen As Integer ' actual key length

Private Type AESctx ' Type to hold the AES context data

Ekey(0 To KeySchLenMax - 1) As Long

Nrnd As Long

Ncol As Long

End Type

Private Type KeyBlk ' Type to hold user key data

K(0 To KeyLenMax - 1) As Byte

End Type

Private Type IoBlk ' Type to hold cipher input and output blocks

IO(0 To BlkLenMax - 1) As Byte

End Type

Rem Change "d:\dll_pth" in the following lines to the directory path where the AES DLL is located

Private Declare Function AesBlkLen Lib "d:\dll_path\aes.dll" Alias "_aes_blk_len@8" (ByVal N As Long, C As AESctx) As Integer

Private Declare Function AesEncKey Lib "d:\dll_path\aes.dll" Alias "_aes_enc_key@12" (K As KeyBlk, ByVal N As Long, C As AESctx) As Integer

Private Declare Function AesDecKey Lib "d:\dll_path\aes.dll" Alias "_aes_dec_key@12" (K As KeyBlk, ByVal N As Long, C As AESctx) As Integer

Private Declare Function AesEncBlk Lib "d:\dll_path\aes.dll" Alias "_aes_enc_blk@12" (Ib As IoBlk, Ob As IoBlk, C As AESctx) As Integer

Private Declare Function AesDecBlk Lib "d:\dll_path\aes.dll" Alias "_aes_dec_blk@12" (Ib As IoBlk, Ob As IoBlk, C As AESctx) As Integer

Private Sub Hex(X As Byte) ' Output a byte in hexadecimal format

Dim H As Byte

H = Int(X / 16)

If H <>

Debug.Print Chr(48 + H);

Else

Debug.Print Chr(87 + H);

End If

H = Int(X Mod 16)

If H <>

Debug.Print Chr(48 + H);

Else

Debug.Print Chr(87 + H);

End If

End Sub

Private Sub OutKey(S As String, B As KeyBlk) ' Display a key value

Debug.Print: Debug.Print S;

For i = 0 To KeyLen - 1

Hex B.K(i)

Next i

End Sub

Private Sub OutBlock(S As String, B As IoBlk) ' Display an input/output block

Debug.Print: Debug.Print S;

For i = 0 To BlkLen - 1

Hex B.IO(i)

Next i

End Sub

Rem The following Main routine should output the following in the immediate window:

Rem Key = 00000000000000000000000000000000

Rem Input = 00000000000000000000000000000000

Rem Encrypted Text = 66e94bd4ef8a2c3b884cfa59ca342b2e

Rem Decrypted Text = 00000000000000000000000000000000

Sub Main()

Dim Key As KeyBlk ' These variables are automatically

Dim Ib As IoBlk, Ob As IoBlk, Rb As IoBlk

Dim Cx As AESctx ' initialised to zero values in VBA

Dim RetVal As Integer

BlkLen = 16: KeyLen = 16

Rem RetVal = AesBlkLen(BlkLen, Cx) ' include if the cipher block size is variable

OutKey "Key = ", Key

OutBlock "Input = ", Ib

RetVal = AesEncKey(Key, KeyLen, Cx) ' set an all zero encryption key

RetVal = AesEncBlk(Ib, Ob, Cx) ' encrypt Ib to Ob

OutBlock "Encrypted Text = ", Ob

RetVal = AesDecKey(Key, KeyLen, Cx) ' set an all zero decryption key

RetVal = AesDecBlk(Ob, Rb, Cx) ' decrypt Ob to Rb

OutBlock "Decrypted Text = ", Rb

Debug.Print

End Sub