Hello,
2016-03-07 Noticed that is the page reload, the session variables are reset. I must initiate session on page reload. Code will change soon to include a basic code inside main loop.
2015-08-09 completly changed the mysql database and data creation to use a function and dynamic arrays
My last post about login and password in PHP was really short
So i added some MYSQL
Mysql is a database engine
In this program we will initialise variables at the start (before login)
Then we will create a database (siteweb01) if it does not exist
Then we will create a table (users01) if it does not exist
Then we will create columns (fields) for this table
Important: the column name will all have the same name as the arrays that contain the logins, passwords, and fullname (and securitylevel)
One column will be "id" wich name will never change, is a primary key, and is autoincrement
We never update the field "id"
An "id" field is mandatory for a table (in theory)
One column will become a primary key column, and will contain the loginname (we do not want the same loginname for 2 persons)
I also added a session variable just in case someone refresh the page. This will prevent the login from being posted twice for no reason.
Be aware that some browsers remember logins and passwords and switch password automatically if there is more than one in memory and if a password fail.
Also, the array containing the loginnames etc. is accessed using dynamic code
(dynamic code = executing some php code inside a variable with eval)
This is because i did not want my array to be only 2 dimensionnals array with numbers
First dimension would have been the users (1 dimension for each user)
Second dimension would have been: loginname, fullname, password etc. (0, 1, 2 etc.)
I did not want "fullname" to be array dimension 0
I wanted my array to have nice names
Debugmode can be put to 0 if you dont want all the trash text in the web page
This code is meant as a model, so error trapping is everywhere.
Requirements:
So the requirement for this is still WAMP, wich include a apache web server and mysql service
If your wamp icon is yellow, only the web part may be active, not the mysql service
You must install and activate the mysql service (in the wamp icon menu)
Create this file with notepad.exe
Save this in c:\wamp\www
---------------------- index.php ---------------------------------
<!DOCTYPE html>
<html:html>
<html:body>
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1" /><div>
<title>Login and password in PHP</title>
</head>
<body>
<?php
// debug mode is ON, lots of echo will display message about working order of the page
$debugmode = 1;
session_start();
header("Cache-Control: private, max-age=10800, pre-check=10800");
if(!isset($_COOKIE["PHPSESSID"]))
{
// first load of page
// initialize session variables
$_SESSION['loginok'] = 0;
$_SESSION['securitylevel'] = 0;
$_SESSION['username'] = "";
$_SESSION['fullname'] = "Guest";
$_SESSION['logindone'] = 0;
if($debugmode==1) {echo "SESSION variables initialized<br>";};
// second load of page or more
if($debugmode==1) {echo "Not first load, no global variables initializing<br>";};
//if($debugmode==1) {echo "Session logindone: " . $_SESSION['logindone']."<br>";};
};
if(!isset($userstot))
{
// initialize program variables (in this sub, not public to functions or sub, not shared to any other program
if($debugmode==1) {echo "Variables initialized<br>";};
// mysql database
$mysqldbname = "siteweb01";
// mysql users table
$mysqltablename = "users01";
// used to read user and authenticate
$mysqluserstable = "users01";
// mysql fields to create in table
// struct equivalent to be able to pass one array as parameter to create the sql table with the data
$i = 0;
$mysqlfields[$i]['fieldname'] = "username";
$mysqlfields[$i]['type'] = "VARCHAR(50)";
$mysqlfields[$i]['primarykey'] = 1; // 1 = this will be a primary key column, 0 = not
$mysqlfields[$i]['autoincrement'] = 0;
$i++;
$mysqlfields[$i]['fieldname'] = "password";
$mysqlfields[$i]['type'] = "VARCHAR(50)";
$mysqlfields[$i]['primarykey'] = 0; // 1 = this will be a primary key column, 0 = not
$mysqlfields[$i]['autoincrement'] = 0;
$i++;
$mysqlfields[$i]['fieldname'] = "fullname";
$mysqlfields[$i]['type'] = "VARCHAR(255)";
$mysqlfields[$i]['primarykey'] = 0; // 1 = this will be a primary key column, 0 = not
$mysqlfields[$i]['autoincrement'] = 0;
$i++;
$mysqlfields[$i]['fieldname'] = "securitylevel";
$mysqlfields[$i]['type'] = "VARCHAR(50)";
$mysqlfields[$i]['primarykey'] = 0; // 1 = this will be a primary key column, 0 = not
$mysqlfields[$i]['autoincrement'] = 0;
$i++;
$mysqlfields[$i]['fieldname'] = "id"; // there must ALWAYS be an ID column (primary key automatically, name in lowercase)
$mysqlfields[$i]['type'] = ""; // type does not matter as this is altered to be a primary key
$mysqlfields[$i]['primarykey'] = 1; // 1 = this will be a primary key column, 0 = not
$mysqlfields[$i]['autoincrement'] = 1; // a id column is always autoincrement
// struct
$i = 0;
$mysqldatas[$i]['username'] = "admin";
$mysqldatas[$i]['password'] = "admin";
$mysqldatas[$i]['fullname'] = "Serge Fournier";
$mysqldatas[$i]['securitylevel'] = 100;
$i++;
$mysqldatas[$i]['username'] = "admin2";
$mysqldatas[$i]['password'] = "admin2";
$mysqldatas[$i]['fullname'] = "Serge Fournier 2";
$mysqldatas[$i]['securitylevel'] = 50;
$userstot = count($mysqldatas); // total users would be 2
// create a mysql database with the login array
// connect to mysql server locally @ = no php error if it fail
$con01 = @mysqli_connect("localhost","root","","");
if(mysqli_connect_error()==null)
{
// call mysql db, table, field creation and insertion or update if primary key exist
$dummy = makemysql($con01, $mysqldbname, $mysqltablename, $mysqlfields, $mysqldatas);
}
else
{
echo "ERROR mysqli_connect: " . mysqli_connect_error()."<br>";
unset($con01);
};
// end of creation of database, creation of table, creation of columns(fields), insertion/update of all line from an array for users table
// now, this mysql table was initially from an array
// but now we will be able, later, to add users from the web page itself in the mysql database (new inscriptions)
$errorlogin = "";
}
if(isset($_POST['submitlogin']) and $_SESSION['logindone'] == 0)
{
//if(empty($_POST['username'])){$_SESSION['loginok'] = 0;};
//if(empty($_POST['password'])){$_SESSION['loginok'] = 0;};
$usernameresult = trim($_POST['username']);
$passwordresult = trim($_POST['password']);
$usercnt = 0;
if($debugmode==1) {echo "Total number of users: $userstot <br>";};
// MYSQL validation of login and password (in database we created with the array before we got here)
if(isset($con01))
{
if (mysqli_select_db($con01, $mysqldbname))
{
if ($result01 = mysqli_query($con01,"SELECT * FROM $mysqluserstable"))
{
// connect, db, and query are ok
while ($row = $result01->fetch_array())
{
// list all login and passwords in the sql database
// echo '<br>line: '.$row["username"].' '.$row["password"].' '.$row["securitylevel"].'<br>';
if($usernameresult == $row["username"])
{
if($debugmode==1) {echo "Username valid, cheking password...<br>";};
if($passwordresult == $row["password"])
{
$_SESSION['loginok'] = 1;
$_SESSION['fullname'] = $row["fullname"];
$_SESSION['username'] = $row["username"];
$_SESSION['securitylevel'] = $row["securitylevel"];
// if($debugmode==1) {echo "session value (1 is login and password ok, 0 is bad something): " . $_SESSION['loginok']."<br>";};
$_SESSION['logindone'] = 1;
if($debugmode==1) {echo "Session logindone: " . $_SESSION['logindone']." Session loginok: ".$_SESSION['loginok']."<br>";};
};
}; //if($usernameresult == $row["username"])
}; // while
mysqli_free_result($result01);
}
else
{
// query sucess
echo "ERROR mysql query returned an error<br>";
echo("ERROR mysqli_query: ".mysqli_errno($con01)." ".mysqli_error($con01)."<br>");
}; //mysqli_query
}
else
{
echo "ERROR mysql database selection did not work<br>";
echo("ERROR mysqli_select_db: " . mysqli_errno($con01)." ".mysqli_error($con01)."<br>");
}; // mysqli_select_db
}
else
{
echo "ERROR mysql connection does not exist: con01<br>";
}; // mysqli_connect
/* // array validation of login and password
foreach($username as $usernameloop)
{
if($usernameresult == $usernameloop)
{
if($debugmode==1) {echo "Username valid, cheking password...<br>";};
if($passwordresult == $password[$usercnt])
{
$_SESSION['loginok'] = 1;
$_SESSION['fullname'] = $fullname[$usercnt];
$_SESSION['username'] = $username[$usercnt];
$_SESSION['securitylevel'] = $securitylevel[$usercnt];
if($debugmode==1) {echo "session value (1 is login and password ok, 0 is bad something): " . $_SESSION['loginok']."<br>";};
$_SESSION['logindone'] = 1;
if($debugmode==1) {echo "Session logindone (submitlogin): " . $_SESSION['logindone']."<br>";};
};
};
$usercnt = $usercnt + 1;
};
*/
// is login and password ok? if not set an error message for next page reload
if($_SESSION['loginok'] == 1)
{
$errorlogin = "";
}
else
{
$errorlogin = "ERROR Wrong login or password. This is case sensitive. Chek your caps lock state";
};
};
if(isset($_POST['submitlogoff']))
{
$_SESSION['loginok'] = 0;
$_SESSION['logindone'] = 0;
// close mysql connection
if(isset($con01))
{
mysqli_close($con01);
unset($con01);
};
if($debugmode==1) {echo "Session logindone (submitlogoff): " . $_SESSION['logindone']."<br>";};
};
if($_SESSION['loginok'] == 1)
{
// second load of page (this is a view refresh)
// main program ///////////////////////////////////////////////
echo "<h1>Main program</h1><br>";
echo "<br>Welcome ".$_SESSION['fullname']."<br>";
echo "<br>Your username is: ".$_SESSION['username']."<br>";
echo "<br>Your security level is: ".$_SESSION['securitylevel']."<br>";
// mysql connexion (for verification of list of users and password)
if(isset($con01))
{
if (mysqli_select_db($con01, $mysqldbname))
{
// the row will be in an array
// we will build query dynamically with all rows
// so we can use the same array to write to database
if ($result01 = mysqli_query($con01,"SELECT * FROM $mysqluserstable"))
{
// connect, db, and query are ok
while ($row = $result01->fetch_array())
{
// list all login and passwords in the sql database
// activate if you want to verify something
// echo '<br>line: '.$row["username"].' '.$row["password"].' '.$row["securitylevel"].'<br>';
};
mysqli_free_result($result01);
}
else
{
// query sucess
echo "ERROR mysql query returned an error<br>";
echo("ERROR mysqli_query: " . mysqli_errno($con01));
}; //mysqli_query
}
else
{
echo "ERROR mysql database selection did not work<br>";
echo("ERROR mysqli_select_db: " . mysqli_errno($con01)."<br>");
}; // mysqli_select_db
}
else
{
echo "ERROR mysql connection does not exist: con01<br>";
}; // mysqli_connect
// logoff button
$html = "";
$html.="<br><form id='logoff' action='{$_SERVER['PHP_SELF']}' method='post' accept-charset='UTF-8'>";
$html.="<fieldset>";
$html.="<legend>Logoff</legend>";
$html.="<input type='submit' name='submitlogoff' value='Logoff' />";
$html.="</fieldset>";
$html.="</form>";
echo $html;
ob_flush(); // empty any web browser buffer so text display immediatly
flush();
}
else
{
// login form, username and password box
if($debugmode==1) {echo "Session loginok value: " . $_SESSION['loginok'] . " (0 = you are not logged in)<br>";};
$html="<form id='login' action='{$_SERVER['PHP_SELF']}' method='post' accept-charset='UTF-8'>";
$html.="<fieldset>";
$html.="<legend>Login</legend>";
$html.="<label for='username' >UserName*:</label>";
$html.="<input type='text' name='username' id='username' maxlength='50' />";
$html.="<label for='password' >Password*:</label>";
$html.="<input type='password' name='password' id='password' maxlength='50' />";
$html.="<input type='submit' name='submitlogin' value='Login' /> $errorlogin";
$html.="</fieldset>";
$html.="</form>";
echo $html;
ob_flush(); // empty any web browser buffer so text display immediatly
flush();
};
///////////////////////////////////////////////////////////////////////////////////
function makemysql($con01, $mysqldbname, $mysqltablename, $mysqlfields, $mysqldatas)
{
// this function will create a mysqldatabase and upinsert data in it
// insert if data do not exist
// update if data primary key exist (there must be a primary key field, like "username"
// reference
// $mysqlfields[$i]['fieldname'] = "fullname";
// $mysqlfields[$i]['type'] = "VARCHAR(255)";
// $mysqlfields[$i]['primarykey'] = 0; // 1 = this will be a primary key column, 0 = not
// $mysqlfields[$i]['autoincrement'] = 0;
global $debugmode;
if($debugmode==1) {echo "<br>Function to create mysql database, table, fields, upinsert data<br>";};
// does database exist?
if (!mysqli_select_db($con01, $mysqldbname))
{
echo("Creating database: $mysqldbname<br>");
$query = "CREATE DATABASE $mysqldbname";
mysqli_query($con01,$query);
$query = "ALTER DATABASE `$mysqldbname` CHARACTER SET utf8 COLLATE utf8_general_ci";
mysqli_query($con01,$query);
}
else
{
// database already exist
if($debugmode==1) {echo "MYSQL database $mysqldbname already exist<br>";};
};
// selecting database
if (mysqli_select_db($con01, $mysqldbname))
{
// database exist
// checking if table exist
$query ="SELECT * FROM $mysqltablename limit 1";
if (!$result01 = mysqli_query($con01, $query))
{
if($debugmode==1) {echo "ERROR mysql table does not exist or no answer: $query<br>";};
// creating table
$query = "CREATE TABLE `$mysqldbname`.`$mysqltablename`( `".$mysqlfields[0]['fieldname']."` ".$mysqlfields[0]['type'].")";
if($debugmode==1) {echo "MYSQL creating table: $query<br>";};
$result01 = mysqli_query($con01,$query);
}
else
{
if($debugmode==1) {echo "MYSQL Table responded: $query<br>";};
};
$query ="SELECT * FROM $mysqltablename limit 1";
if ($result01 = mysqli_query($con01,$query))
{
$columnscnt = 0;
foreach($mysqlfields as $mysqlfield)
{
//$columnname = $mysqlfield['fieldname'];
if (!$result01 = mysqli_query($con01,"SELECT ".$mysqlfield['fieldname']." FROM $mysqltablename limit 1"))
{
if($debugmode==1) {echo "MYSQL Column does not exist: ".$mysqlfield['fieldname']."<br>";};
// creating column
$query = "ALTER TABLE `$mysqldbname`.`$mysqltablename` ADD COLUMN `".$mysqlfield['fieldname']."` ".$mysqlfield['type'];
// NULL AFTER 'fullname'"
// ID
if($mysqlfield['fieldname'] == "id")
{
$query = "ALTER TABLE `$mysqldbname`.`$mysqltablename` ADD COLUMN `id` INT NULL AUTO_INCREMENT, ADD KEY(`id`);";
};
if (!$result01 = mysqli_query($con01,$query))
{
echo "ERROR mysql altering table, inserting column: ".$mysqlfield['fieldname']."<br>";
echo "ERROR mysql altering table, inserting column: $query<br>";
}
else
{
if($debugmode==1) {echo "MYSQL Column created: $query<br>";};
};
}
else
{
if($debugmode==1) {echo "MYSQL Column ok: ".$mysqlfield['fieldname']."<br>";};
};
$columnscnt = $columnscnt + 1;
};
// add primary key for some columns
$columnscnt = 0;
foreach($mysqlfields as $mysqlfield)
{
//if($debugmode==1) {echo ($mysqlprimarykey[$columnscnt] == 1 and $columnname !== "id")."<br>";};
// add primary key if this column require it. NOTE: if this is added after column wa created, it wont execute because column already exist
if($mysqlfield['primarykey'] == 1 and $mysqlfield['fieldname'] !== "id") // Id column is exempted as it is created as non null autoincrement already
{
$query = "ALTER TABLE `$mysqldbname`.`$mysqltablename` CHANGE `".$mysqlfield['fieldname']."` `".$mysqlfield['fieldname']."` ".$mysqlfield['type']." ";
$query.="CHARSET utf8 COLLATE utf8_general_ci NOT NULL, ADD PRIMARY KEY (`".$mysqlfield['fieldname']."`);";
if (!$result01 = mysqli_query($con01,$query))
{
if($debugmode==1) {echo "ERROR MYSQL column defined as primary key: $query<br>";};
if($debugmode==1) {echo "ERROR ".mysqli_errno($con01)." ".mysqli_error($con01)."<br>";};
// Multiple primary key defined (when we redo the same primary key)
}
else
{
if($debugmode==1) {echo "MYSQL column defined as primary key: ".$mysqlfield['fieldname']."<br>";};
};
};
$columnscnt = $columnscnt + 1;
};
// verification if creation of a column worked
$columnscnt = 0;
$fatalerror = 0;
foreach($mysqlfields as $mysqlfield)
{
if (!$result01 = mysqli_query($con01,"SELECT ".$mysqlfield['fieldname']." FROM $mysqltablename limit 1"))
{
if($debugmode==1) {echo "ERROR MYSQL Column does not exist after we tried to create it: ".$mysqlfield['fieldname']."<br>";};
$fatalerror = $fatalerror + 1;
};
$columnscnt = $columnscnt + 1;
}
if($fatalerror == 0)
{
if($debugmode==1) {echo "MYSQL Column existence verified. missing: $fatalerror<br>";};
// all columns exist (we did not check their type tough)
if($debugmode==1) {echo "MYSQL all columns ok, database ok, table ok<br>";};
///////////////////////////////////////////////////////////
// insert stuff (array) in database/table if it does not exist (merge or upinsert)
///////////////////////////////////////////////////////////
// upinsert all elements from array in the database
$line = 0;
foreach($mysqldatas as $mysqldata)
{
$querypart1 ="insert into `$mysqltablename` (";
$querypart2 =") values (";
$querypart3 =") ON DUPLICATE KEY UPDATE ";
$columnscnt = 0;
$columnmax = count($mysqlfields);
if($debugmode==1) {echo "Inserting a line with ".$columnmax." columns. Line: ".$line."<br>";};
foreach($mysqlfields as $mysqlfield)
{
// DO NOT INCLUDE ID IN a merge (also called upinsert or insert on duplicate key update in mysql)
if ($mysqlfield['fieldname']!= "id")
{
$querypart1.="`".$mysqlfield['fieldname']."`";
// instead of having only number array
// i use eval to get the name of the array that contain each column value we want
// the name of the column in mysql is the same name as the array that contain the value we want
// test string (to see what i do with all the \ to be able to use " inside the eval
$test="";
//$test = "\$querypart2.=$mysqldata[$mysqlfield['fieldname']];
//if($debugmode==1) {echo($columnscnt." ".$test."<br>");};
//if($debugmode==1) {echo("data: ".$mysqldata[$mysqlfield['fieldname']]."<br>");};
// dynamic code. all this code is replaced by the eval
//if($columnscnt==0) {$querypart2.="'".$username[$line]."'";};
//if($columnscnt==1) {$querypart2.="'".$password[$line]."'";};
//if($columnscnt==2) {$querypart2.="'".$fullname[$line]."'";};
//if($columnscnt==3) {$querypart2.=$securitylevel[$line];};
//eval("\$querypart2.=\"'\".$".$columnname."[\$line].\"'\";");
$querypart2.="'".$mysqldata[$mysqlfield['fieldname']]."'";
// the value mysql need when the insert become an update
// when the line we want to insert have a primary key identical to what we try to insert
// in this case, username is defined as a primary key in mysql when we create the column in precedent lines
$querypart3.=$mysqlfield['fieldname']."=values(".$mysqlfield['fieldname'].")";
// id=LAST_INSERT_ID(id)
if($columnscnt!=$columnmax-1)
{
if($mysqlfields[$columnscnt + 1]['fieldname'] != "id")
{
$querypart1.=",";
$querypart2.=",";
$querypart3.=",";
};
};
}; // ($columnname != "id")
$columnscnt = $columnscnt + 1;
}; // for each columnname
if($debugmode==1) {echo "MYSQL insert on duplicate key update: ".$querypart1.$querypart2.$querypart3."<br>";};
// ON DUPLICATE UPDATE b = VALUES(b), c = VALUES(c)
$query = $querypart1.$querypart2.$querypart3;
//"INSERT INTO `$mysqldbname`.`$mysqltablename` (`username`, `password`, `securitylevel`, `fullname`) VALUES ('admin', 'admin', '100', 'Serge Fournier');";
if ($result01 = mysqli_query($con01,$query))
{
if($debugmode==1) {echo "MYSQL insert on duplicate key update success<br>";};
}
else
{
if($debugmode==1) {echo "ERROR MYSQL insert on duplicate key update<br>";};
};
$line++;
}; // for $line
}
else
{
echo "ERROR mysql $fatalerror column is missing after we tried to create all columns, at verification of it's existence<br>";
}; // if fatalerror
}
else
{
echo "ERROR mysql table does not exist after we tried to create it: $mysqltablename<br>";
}; //if ($result01 = mysqli_query($con01,$query))
}
else
{
echo "ERROR mysql we tried to create database<br>";
echo "ERROR mysql after trying to create database, mysqli_select_db did not work<br>";
echo("ERROR mysqli_select_db: " . mysqli_errno($con01)."<br>");
}; //if (mysqli_select_db($con01, $mysqldbname))
if($debugmode==1) {echo "<br>";};
};
?>
</html>
</body>
</html:body>
</html:html>
Sunday, August 9, 2015
Saturday, August 1, 2015
php login and password authentication
Hello,
2015-08-08 changed the detection of view for a session detection with a cookie (default name of a php session)
A friend asked me to add a login and password to his php web site
I checked internet, I did not find a nice example (well, not quickly)
Security concern:
This type of login and password is half secure (if someone hack your root, he will get all login and passwords!!!)
Requirement package:
wampserver2.5-Apache-2.4.9-Mysql-5.6.17-php5.5.12-64b.exe
Requirement procedure:
To start a php web site locally, port 80 must be free, close skype or set his additionnals call option off on on another port
Install php WAMP
Copy index.php in c:\wamp\www
Type localhost in adress bar of any browser to access your local site (this will pick index.php as the first php web page)
----------------- index.php ----- use notepad.exe or notepad2.exe ------------------
<!DOCTYPE html>
<html:html>
<html:body>
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1" /><div>
<title>Login and password in PHP</title>
</head>
<body>
<?php
// debug mode is ON, lost of echo will display message about working order of the page
$debugmode = 1;
session_start();
// initialize global variables on first load of page
// view indicate a refresh if it set, but ! mean it is not set
if(!isset($_COOKIE["PHPSESSID"]))
{
// first load of page
// initialize session variables
$_SESSION['loginok'] = 0;
$_SESSION['securitylevel'] = 0;
$_SESSION['username'] = "";
$_SESSION['fullname'] = "Guest";
if($debugmode==1) {echo "globals SESSION variables initialized";};
}
else
{
// second load of page or more
if($debugmode==1) {echo "Not first load, no global variables initializing<br>";};
};
if(!isset($userstot))
{
// initialize program variables (in this sub, not public to functions or sub, not shared to any other program
if($debugmode==1) {echo "Globals regular variables initialized<br>";};
$i = 0;
$username[$i]="admin";
$password[$i]="admin";
$fullname[$i]="Serge Fournier";
$securitylevel[$i] = "100";
$i++;
$username[$i]="admin2";
$password[$i]="admin2";
$fullname[$i]="Serge Fournier 2";
$securitylevel[$i] = "10";
$userstot = count($username); // total users would be 2
$errorlogin = "";
}
if(isset($_POST['submitlogin']))
{
//if(empty($_POST['username'])){$_SESSION['loginok'] = 0;};
//if(empty($_POST['password'])){$_SESSION['loginok'] = 0;};
$usernameresult = trim($_POST['username']);
$passwordresult = trim($_POST['password']);
$usercnt = 0;
if($debugmode==1) {echo "Total number of users: $userstot <br>";};
foreach($username as $usernameloop)
{
if($usernameresult == $usernameloop)
{
if($debugmode==1) {echo "Username valid, cheking password...<br>";};
if($passwordresult == $password[$usercnt])
{
$_SESSION['loginok'] = 1;
$_SESSION['fullname'] = $fullname[$usercnt];
$_SESSION['username'] = $username[$usercnt];
$_SESSION['securitylevel'] = $securitylevel[$usercnt];
if($debugmode==1) {echo "session value (1 is login and password ok, 0 is bad something): " . $_SESSION['loginok']."<br>";};
};
};
$usercnt = $usercnt + 1;
};
if($_SESSION['loginok'] == 1)
{
$errorlogin = "";
}
else
{
$errorlogin = "ERROR Wrong login or password. This is case sensitive. Chek your caps lock state";
};
};
if(isset($_POST['submitlogoff']))
{
$_SESSION['loginok'] = 0;
};
if($_SESSION['loginok'] == 1)
{
// second load of page (this is a view refresh)
// main program ///////////////////////////////////////////////
echo "<h1>Main program</h1><br>";
echo "<br>Welcome ".$_SESSION['fullname']."<br>";
echo "<br>Your username is: ".$_SESSION['username']."<br>";
echo "<br>Your security level is: ".$_SESSION['securitylevel']."<br>";
// logoff button
$html = "";
$html.="<br><form id='logoff' action='{$_SERVER['PHP_SELF']}' method='post' accept-charset='UTF-8'>";
$html.="<fieldset>";
$html.="<legend>Logoff</legend>";
$html.="<input type='submit' name='submitlogoff' value='Logoff' />";
$html.="</fieldset>";
$html.="</form>";
echo $html;
ob_flush(); // empty any web browser buffer so text display immediatly
flush();
}
else
{
// login form, username and password box
if($debugmode==1) {echo "Session loginok value: " . $_SESSION['loginok'] . " (0 = you are not logged in)<br>";};
$html="<form id='login' action='{$_SERVER['PHP_SELF']}' method='post' accept-charset='UTF-8'>";
$html.="<fieldset>";
$html.="<legend>Login</legend>";
$html.="<label for='username' >UserName*:</label>";
$html.="<input type='text' name='username' id='username' maxlength='50' />";
$html.="<label for='password' >Password*:</label>";
$html.="<input type='password' name='password' id='password' maxlength='50' />";
$html.="<input type='submit' name='submitlogin' value='Login' /> $errorlogin";
$html.="</fieldset>";
$html.="</form>";
echo $html;
ob_flush(); // empty any web browser buffer so text display immediatly
flush();
};
?>
</html>
</body>
</html:body>
</html:html>
2015-08-08 changed the detection of view for a session detection with a cookie (default name of a php session)
A friend asked me to add a login and password to his php web site
I checked internet, I did not find a nice example (well, not quickly)
Security concern:
This type of login and password is half secure (if someone hack your root, he will get all login and passwords!!!)
Requirement package:
wampserver2.5-Apache-2.4.9-Mysql-5.6.17-php5.5.12-64b.exe
Requirement procedure:
To start a php web site locally, port 80 must be free, close skype or set his additionnals call option off on on another port
Install php WAMP
Copy index.php in c:\wamp\www
Type localhost in adress bar of any browser to access your local site (this will pick index.php as the first php web page)
----------------- index.php ----- use notepad.exe or notepad2.exe ------------------
<!DOCTYPE html>
<html:html>
<html:body>
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1" /><div>
<title>Login and password in PHP</title>
</head>
<body>
<?php
// debug mode is ON, lost of echo will display message about working order of the page
$debugmode = 1;
session_start();
// initialize global variables on first load of page
// view indicate a refresh if it set, but ! mean it is not set
if(!isset($_COOKIE["PHPSESSID"]))
{
// first load of page
// initialize session variables
$_SESSION['loginok'] = 0;
$_SESSION['securitylevel'] = 0;
$_SESSION['username'] = "";
$_SESSION['fullname'] = "Guest";
if($debugmode==1) {echo "globals SESSION variables initialized";};
}
else
{
// second load of page or more
if($debugmode==1) {echo "Not first load, no global variables initializing<br>";};
};
if(!isset($userstot))
{
// initialize program variables (in this sub, not public to functions or sub, not shared to any other program
if($debugmode==1) {echo "Globals regular variables initialized<br>";};
$i = 0;
$username[$i]="admin";
$password[$i]="admin";
$fullname[$i]="Serge Fournier";
$securitylevel[$i] = "100";
$i++;
$username[$i]="admin2";
$password[$i]="admin2";
$fullname[$i]="Serge Fournier 2";
$securitylevel[$i] = "10";
$userstot = count($username); // total users would be 2
$errorlogin = "";
}
if(isset($_POST['submitlogin']))
{
//if(empty($_POST['username'])){$_SESSION['loginok'] = 0;};
//if(empty($_POST['password'])){$_SESSION['loginok'] = 0;};
$usernameresult = trim($_POST['username']);
$passwordresult = trim($_POST['password']);
$usercnt = 0;
if($debugmode==1) {echo "Total number of users: $userstot <br>";};
foreach($username as $usernameloop)
{
if($usernameresult == $usernameloop)
{
if($debugmode==1) {echo "Username valid, cheking password...<br>";};
if($passwordresult == $password[$usercnt])
{
$_SESSION['loginok'] = 1;
$_SESSION['fullname'] = $fullname[$usercnt];
$_SESSION['username'] = $username[$usercnt];
$_SESSION['securitylevel'] = $securitylevel[$usercnt];
if($debugmode==1) {echo "session value (1 is login and password ok, 0 is bad something): " . $_SESSION['loginok']."<br>";};
};
};
$usercnt = $usercnt + 1;
};
if($_SESSION['loginok'] == 1)
{
$errorlogin = "";
}
else
{
$errorlogin = "ERROR Wrong login or password. This is case sensitive. Chek your caps lock state";
};
};
if(isset($_POST['submitlogoff']))
{
$_SESSION['loginok'] = 0;
};
if($_SESSION['loginok'] == 1)
{
// second load of page (this is a view refresh)
// main program ///////////////////////////////////////////////
echo "<h1>Main program</h1><br>";
echo "<br>Welcome ".$_SESSION['fullname']."<br>";
echo "<br>Your username is: ".$_SESSION['username']."<br>";
echo "<br>Your security level is: ".$_SESSION['securitylevel']."<br>";
// logoff button
$html = "";
$html.="<br><form id='logoff' action='{$_SERVER['PHP_SELF']}' method='post' accept-charset='UTF-8'>";
$html.="<fieldset>";
$html.="<legend>Logoff</legend>";
$html.="<input type='submit' name='submitlogoff' value='Logoff' />";
$html.="</fieldset>";
$html.="</form>";
echo $html;
ob_flush(); // empty any web browser buffer so text display immediatly
flush();
}
else
{
// login form, username and password box
if($debugmode==1) {echo "Session loginok value: " . $_SESSION['loginok'] . " (0 = you are not logged in)<br>";};
$html="<form id='login' action='{$_SERVER['PHP_SELF']}' method='post' accept-charset='UTF-8'>";
$html.="<fieldset>";
$html.="<legend>Login</legend>";
$html.="<label for='username' >UserName*:</label>";
$html.="<input type='text' name='username' id='username' maxlength='50' />";
$html.="<label for='password' >Password*:</label>";
$html.="<input type='password' name='password' id='password' maxlength='50' />";
$html.="<input type='submit' name='submitlogin' value='Login' /> $errorlogin";
$html.="</fieldset>";
$html.="</form>";
echo $html;
ob_flush(); // empty any web browser buffer so text display immediatly
flush();
};
?>
</html>
</body>
</html:body>
</html:html>
Sunday, July 26, 2015
Bubble sort with supertotal in excel VBA
Hello,
So i decided, as i am a good guy, to reprogram my supertotal bubble sort in excel vba
Not that i am a good guy, but everyone think excel is a god, so i had to...
It will generate 3 excel tables with the dataset example (wich you can replace with a sql query)
It will still generate a log file starting with ZZZ
It will still generate a html file with all the tables
Requirements:
microsoft excel 2013
.xlsm extension (file with macro)
Activation of vba macros if excel present a warning
26/07/2015 19:48:14 Start of bubble sort example
TABLE 01 Dataset was sorted with dataset.sort by index field, alphanumeric sorting
TABLE 02 Split all the values to get only numbers and calculate a supertotal
TABLE 03 sorted after all was converted to number to make a supertotal
---------------------- excel VBA macro (alt F11, add module, insert this code) ---------------------
Sub bubblesort01()
'=== bubblesort_wildboy85.vbs
'=== requirement: wscript.exe
'=== very fast bubble sort
'=== by wildboy85 (sergefournier @ hotmail.com)
'=== objects needed
Set objFSo = CreateObject("Scripting.FileSystemObject")
Set objshe = CreateObject("WScript.Shell")
Set objNet = CreateObject("WScript.Network")
'=== register base constants
Const hkcr = &H80000000 'HKEY_CLASSES_ROOT
Const HKCU = &H80000001 'HKEY_CURRENT_USER
Const hklm = &H80000002 'HKEY_LOCAL_MACHINE
Const hku = &H80000003 'HKEY_USERS
Const hkcc = &H80000005 'HKEY_CURRENT_CONFIG
Const ForReading = 1
Const adVarChar = 200
Const MaxCharacters = 255
Const adDouble = 5
'=== actual drive, actual directory, and "\"
'thepath = Application.ActiveWorkbook.path
thepath = Application.ActiveWorkbook.FullName
p = InStrRev(thepath, "\")
basedir = Left(thepath, p)
filnam = Right(thepath, Len(thepath) - p)
'=== log what we do, in same directory as the script
logall = 1
htmlout = 1
If logall = 1 Then
'=== debug log, get this file name, remove end, change start for ZZZ
'=== remove .vbs
path01 = Left(thepath, Len(thepath) - (Len(thepath) - InStr(thepath, ".") + 1))
name01 = Right(path01, Len(path01) - InStrRev(path01, "\"))
logname01 = "zzz_" & name01 & ".txt"
'=== always have a nice error trapping
err01 = 0: err02 = ""
On Error Resume Next
Set file02 = objFSo.OpenTextFile(logname01, 2, True)
err01 = Err: err02 = Err.Description
On Error GoTo 0
End If
If err01 = 0 Then
logall = 1
Else
'=== flag to tell our program to not write in log file if there is not log file open
logall = 0 '=== could not open logfile, no log
End If
'=== html output file, we want a nice table as output
If htmlout = 1 Then
path01 = Left(thepath, Len(thepath) - (Len(thepath) - InStr(thepath, ".") + 1))
name01 = Right(path01, Len(path01) - InStrRev(path01, "\"))
logname01 = name01 & "_output.html"
'=== always have a nice error trapping
err01 = 0: err02 = ""
On Error Resume Next
Set file03 = objFSo.OpenTextFile(logname01, 2, True)
err01 = Err: err02 = Err.Description
On Error GoTo 0
End If
If err01 = 0 Then
htmlout = 1
Else
'=== flag to tell our program to not write in log file if there is not log file open
htmlout = 0 '=== could not open logfile, no log
End If
If logall = 1 Then file02.WriteLine Date & " " & Time & " START Bubble sort wildboy85"
'=== the dataset could come from a database, but here we will add data ourseleves as an example
Set dataset01 = CreateObject("ADODB.Recordset")
dataset01.Fields.Append "Index", adVarChar, MaxCharacters
If logall = 1 Then file02.WriteLine Date & " " & Time & " First field appended"
dataset01.Fields.Append "item", adVarChar, MaxCharacters
dataset01.Fields.Append "quantity", adDouble
dataset01.Fields.Append "description", adVarChar, MaxCharacters
'dataset01.Fields.Append "supertotal DS", adVarChar, MaxCharacters
dataset01.Open
'=== accessing the column by name is slow, it would be faster by name if we have big loop
dataset01.AddNew
dataset01("Index") = "11a.1c.3b"
dataset01("item") = "bolt"
dataset01("quantity") = 1
dataset01("description") = "this is a bolt"
dataset01.Update
dataset01.AddNew
dataset01("Index") = "1z.10c.3b"
dataset01("item") = "bolt"
dataset01("quantity") = 2
dataset01("description") = "this is a bolt"
dataset01.Update
dataset01.AddNew
dataset01("Index") = "1a.2c.33b"
dataset01("item") = "bolt"
dataset01("quantity") = 45
dataset01("description") = "this is a bolt"
dataset01.Update
dataset01.AddNew
dataset01("Index") = "1b.2c.33"
dataset01("item") = "bolt"
dataset01("quantity") = 12
dataset01("description") = "this is a bolt"
dataset01.Update
dataset01.AddNew
dataset01("Index") = "1c.2c"
dataset01("item") = "bolt"
dataset01("quantity") = 5
dataset01("description") = "this is a bolt"
dataset01.Update
dataset01.AddNew
dataset01("Index") = "10b.2c.33b"
dataset01("item") = "bolt"
dataset01("quantity") = 18
dataset01("description") = "this is a bolt"
dataset01.Update
dataset01.movefirst
'=== how many field? (columns)
fieldscount01 = dataset01.Fields.Count
'=== put the dataset demo in excel page (first) as a table
Dim myarray As Variant
array01 = dataset01.GetRows
'=== get number of rows (dimension 2 of the array)
On Error Resume Next
err01 = 0: err02 = ""
rowcount01 = UBound(array01, 2)
err01 = Err
err02 = Err.Description
On Error GoTo 0
If err01 = 0 Then
'=== 2 dimension in array, we continue (2 row of data is a minimum)
Set Sheet01 = Worksheets(1)
'=== delete old table01 if it exist
tablename01 = "table01"
On Error Resume Next
err01 = 0: err02 = ""
Sheet01.ListObjects(tablename01).Delete
err01 = Err
err02 = Err.Description
On Error GoTo 0
x = 1: y = 1
'=== columns names
For i = 0 To fieldscount01 - 1
Cells(y, x + i).Value = dataset01.Fields(i).Name
Next
'=== range01 include column title
Set Range01 = Range(Cells(y, x), Cells(y + 1 + rowcount01, x + fieldscount01 - 1))
'=== range02 is data only
Set Range02 = Range(Cells(y + 1, x), Cells(y + 1 + rowcount01, x + fieldscount01 - 1))
Range02.Value = Application.WorksheetFunction.Transpose(array01)
Sheet01.ListObjects.Add(xlSrcRange, Range01, , xlYes).Name = tablename01
If logall = 1 Then file02.WriteLine Date & " " & Time & " fieldcount: " & fieldscount01
If htmlout = 1 Then file03.WriteLine Date & " " & Time & " Start of bubble sort example<br><br>"
'=== this datasort will order our items badly, as if number 10 was smaller than number 1
dataset01.Sort = "index"
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' excel table02 sorted with dataset sort command (as string)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'=== read dataset that was sorted as string
array01 = dataset01.GetRows
'=== delete old table01 if it exist
tablename01 = "table02"
On Error Resume Next
err01 = 0: err02 = ""
Sheet01.ListObjects(tablename01).Delete
err01 = Err
err02 = Err.Description
On Error GoTo 0
x = 1: y = (4 + rowcount01) * 1
'=== columns names
For i = 0 To fieldscount01 - 1
Cells(y, x + i).Value = dataset01.Fields(i).Name
Next
'=== range01 include column title
Set Range01 = Range(Cells(y, x), Cells(y + 1 + rowcount01, x + fieldscount01 - 1))
'=== range02 is data only
Set Range02 = Range(Cells(y + 1, x), Cells(y + 1 + rowcount01, x + fieldscount01 - 1))
Range02.Value = Application.WorksheetFunction.Transpose(array01)
Sheet01.ListObjects.Add(xlSrcRange, Range01, , xlYes).Name = tablename01
'=== html table
If htmlout = 1 Then file03.WriteLine " TABLE 01 Dataset was sorted with dataset.sort by index field, alphanumeric sorting<br>"
If htmlout = 1 Then file03.WriteLine "<table width=""70%"" BORDERCOLOR=""black"" class=MsoTableGrid border=1 CELLSPACING=0 cellpadding=2 style='border-collapse:collapse;border:none'>"
'=== fields names as columns titles of the table
If htmlout = 1 Then file03.WriteLine "<tr>"
For i = 0 To fieldscount01 - 1
If htmlout = 1 Then file03.WriteLine "<td>" & dataset01.Fields(i).Name & "</td>"
Next
If htmlout = 1 Then file03.WriteLine "</tr>"
dataset01.movefirst
linecount = 0
Dim ara02()
Do While Not (dataset01.EOF) '=== magica loop, row
ReDim Preserve ara02(fieldscount01 - 1, linecount)
If htmlout = 1 Then file03.WriteLine "<tr>"
'=== put all values in an array, because a dataset this basic cannot switch a line of data
For i = 0 To fieldscount01 - 1
value01 = dataset01.Fields(i).Value
If IsNull(value01) Then value01 = ""
value01 = Trim(value01)
If htmlout = 1 Then file03.WriteLine "<td>" & value01 & "</td>"
ara02(i, linecount) = value01
Next
If htmlout = 1 Then file03.WriteLine "</tr>"
linecount = linecount + 1
dataset01.movenext
Loop
If htmlout = 1 Then file03.WriteLine "</table><br>"
'=== now we will split the line we will use to do the sort by number and letter (converted to numbers)
fieldtosort01 = 0 '=== field 0 contain what we want to sort, example: 1a.2b.3c
'=== we assume we will have only 3 data to sort, 1a 2b 3c
dataset01.movefirst
If htmlout = 1 Then file03.WriteLine "<br>TABLE 02 Split all the values to get only numbers and calculate a supertotal"
If htmlout = 1 Then file03.WriteLine "<table width=""70%"" BORDERCOLOR=""black"" class=MsoTableGrid border=1 CELLSPACING=0 cellpadding=2 style='border-collapse:collapse;border:none'>"
If htmlout = 1 Then file03.WriteLine "<tr><td>split01</td><td>split02</td><td>split03</td>"
If htmlout = 1 Then file03.WriteLine "<td>Number</td><td>Letter</td><td>Number</td><td>Letter</td><td>Number</td><td>Letter</td>"
If htmlout = 1 Then file03.WriteLine "<td>Supertotal</td></tr>"
'=== split the chain 1a.2b.3c by adding dots in case 2b.3c does not exist
Dim split(2)
linecount = 0
Dim ara01()
Do While Not (dataset01.EOF) '=== magica loop, row
ReDim Preserve ara01(6, linecount) '=== the last dimension can be redimensionned so we reversed the dimensions
If htmlout = 1 Then file03.WriteLine "<tr>" '=== html line change
value01 = dataset01.Fields(fieldtosort01).Value
'=== clean value in case of dbnull (dbnull cannot be processed)
If IsNull(value01) Then value01 = ""
value01 = Trim(value01)
'=== add dots at the end of string to later split at the dots and get string inbetween
'=== so if the string have no dots, the split will still work and resturn empty string instead of trying to trap errors
value01 = value01 & "...."
split(0) = Left(value01, Len(value01) - (Len(value01) - InStr(value01, ".") + 1))
leftover = Mid(value01, InStr(value01, ".") + 1, Len(value01))
split(1) = Left(leftover, Len(leftover) - (Len(leftover) - InStr(leftover, ".") + 1))
leftover = Mid(leftover, InStr(leftover, ".") + 1, Len(leftover))
split(2) = Left(leftover, Len(leftover) - (Len(leftover) - InStr(leftover, ".") + 1))
If htmlout = 1 Then file03.WriteLine "<td>" & split(0) & "</td><td>" & split(1) & "</td><td>" & split(2) & "</td>"
'=== we now do an array of 6 fields/columns
'=== field0 is 1, field1 is a, field2 is 2, field3 is b, field4 is 3, field5 is c (from 1a.2b.3c)
splitcount = 0
For x03 = 0 To 5 Step 2 'order01, order01 letter, order02, order02 letter, order03, order03 letter (letter --> integer)
'=== split the split to get 2 value, 1 for number, 1 for alpha (split the chain "1a", "2b", "3c")
data01 = Trim(split(splitcount))
len01 = Len(data01)
If len01 > 1 Then
alpha01 = 0
For i = 1 To len01
'=== is this digit alpha?
asc01 = Asc(Mid(data01, i, 1))
If (asc01 > 64 And asc01 < 91) Or (asc01 > 96 And asc01 < 123) Then
alpha01 = 1
'=== this is a letter
If i > 1 Then
val01 = CInt(Left(data01, i - 1))
Else
End If
'=== code de classement final
'if logall=1 then file02.WriteLine "value before: " & data01 & " After: " & val01 & " + " & asc01 & chr(9) & val01+asc01
If asc01 > 96 Then '=== uppercase A
asc01 = asc01 - 96
ElseIf asc01 > 64 Then '=== lowercase a
asc01 = asc01 - 64
End If
ara01(x03, linecount) = val01 '=== new ordering integer for this column
'=== create a new column to class by letter after this one
ara01(x03 + 1, linecount) = asc01
End If
Next
If alpha01 = 0 Then
'=== remove the 0 before
ara01(x03, linecount) = CInt(data01)
ara01(x03 + 1, linecount) = 0
End If
ElseIf len01 > 0 Then
'=== only 1 digit, so we assume it's a number (just to be faster)
ara01(x03, linecount) = data01 '=== new ordering integer for this column
'=== column to class by letter after this one (1 digit = no letter = 0)
ara01(x03 + 1, linecount) = 0
Else
'=== len is 0, we do nothing
ara01(x03, linecount) = 0
ara01(x03 + 1, linecount) = 0
End If
splitcount = splitcount + 1
'=== results, all numerics
If htmlout = 1 Then file03.WriteLine "<td>" & ara01(x03, linecount) & "</td><td>" & ara01(x03 + 1, linecount) & "</td>"
Next
'=== tricky part, doing a supertotal to sort only one number for all six fields/columns
supertotal = 0
mul01 = 5
super02 = ""
For x03 = 0 To 5
'=== do a super total for this line and the next for comparaison
super01 = (ara01(x03, linecount) + 1) * (1000 ^ (mul01 + 1))
supertotal = supertotal + super01
mul01 = mul01 - 1
'==== alphanumeric supertotal add 0 in front pf every digit, not working with dataset.sort either
'super02 = super02 & left("00000", 5-len((ara01(x03,linecount)+1))) & ara01(x03,linecount)+1
Next
'dataset01.fields("supertotal DS").value = super02
ara01(6, linecount) = supertotal
'dataset01.fields("supertotal DS").value = supertotal
If htmlout = 1 Then file03.WriteLine "<td>" & ara01(6, linecount) & "</td>"
linecount = linecount + 1
If htmlout = 1 Then file03.WriteLine "</tr>"
dataset01.movenext
'=== all supertotal must be computed before we can sort
'=== so this loop was to split numbers, letters and compute a supertotal with multiplicated by 1000^positioninfieldvalue(0-5) values
Loop
If htmlout = 1 Then file03.WriteLine "</table>"
'=== sorting loop, using supertotal
'=== we move through dataset at the same time we move in the array that contain supertotal at position 6
If logall = 1 Then file02.WriteLine Date & " " & Time & " START bubble sort with supertotal"
'=== using SORT command from dataset would have been easy now, but noooo, error argument, number to weird
'=== even if this a string, it cannot sort with dateset.sort command
'dataset01.Sort = "supertotal DS"
dataset01.movefirst
'set row = CreateObject("ADODB.Recordsetrow")
'=== exchange lines in dataset, is that possible?
'dataset01.rows(1) = dataset01.rows(0)
'http://www.w3schools.com/asp/ado_ref_recordset.asp
''''''''''''''''''''''''''''''''''''''''''
' bubble sort
''''''''''''''''''''''''''''''''''''''''''
Dim supertotal01(1)
ReDim ara01tempo(linecount - 1)
If logall = 1 Then file02.WriteLine Date & " " & Time & " Bubble order START"
'=== classement bulle, ligne par ligne, 6 fois
For bubble01 = linecount - 2 To 0 Step -1
For y03 = 0 To bubble01 '=== magica loop, row
'=== if supertotal after is smaller, we exchange them
If ara01(6, y03 + 1) < ara01(6, y03) Then
For x04 = 0 To fieldscount01 - 1
'=== save actual matrix x elements
ara01tempo(x04) = ara02(x04, y03)
ara02(x04, y03) = ara02(x04, y03 + 1) '=== go up one row in matrix
ara02(x04, y03 + 1) = ara01tempo(x04)
Next
'=== exchange supertotal also
supertotaltemp = ara01(6, y03)
ara01(6, y03) = ara01(6, y03 + 1)
ara01(6, y03 + 1) = supertotaltemp
End If
Next
Next
If logall = 1 Then file02.WriteLine Date & " " & Time & " END bubble sort"
'=== final result
If htmlout = 1 Then file03.WriteLine "<br>TABLE 03 sorted after all was converted to number to make a supertotal"
If htmlout = 1 Then file03.WriteLine "<br><table width=""70%"" BORDERCOLOR=""black"" class=MsoTableGrid border=1 CELLSPACING=0 cellpadding=2 style='border-collapse:collapse;border:none'>"
'=== fields names as columns titles of the table
If htmlout = 1 Then file03.WriteLine "<tr>"
For i = 0 To fieldscount01 - 1
If htmlout = 1 Then file03.WriteLine "<td>" & dataset01.Fields(i).Name & "</td>"
Next
If htmlout = 1 Then file03.WriteLine "<td>Supertotal verification (not in DS)</td>"
If htmlout = 1 Then file03.WriteLine "</tr>"
For y = 0 To linecount - 1 '=== display results after bubble sort
If htmlout = 1 Then file03.WriteLine "<tr>"
For x = 0 To fieldscount01 - 1
If htmlout = 1 Then file03.WriteLine "<td>" & ara02(x, y) & "</td>"
Next
If htmlout = 1 Then file03.WriteLine "<td>" & ara01(6, y) & "</td>"
If htmlout = 1 Then file03.WriteLine "</tr>"
Next
''''''''''''''''''''''''''''''''''''''''''''''''''''''
' table03 sorted with 6 columns (split of the first column) and super total
''''''''''''''''''''''''''''''''''''''''''''''''''''''
array01 = ara02
If htmlout = 1 Then file03.WriteLine "</table>"
'=== delete old table01 if it exist
tablename01 = "table03"
On Error Resume Next
err01 = 0: err02 = ""
Sheet01.ListObjects(tablename01).Delete
err01 = Err
err02 = Err.Description
On Error GoTo 0
x = 1: y = (4 + rowcount01) * 2
'=== columns names
For i = 0 To fieldscount01 - 1
Cells(y, x + i).Value = dataset01.Fields(i).Name
Next
'=== range01 include column title
Set Range01 = Range(Cells(y, x), Cells(y + 1 + rowcount01, x + fieldscount01 - 1))
'=== range02 is data only
Set Range02 = Range(Cells(y + 1, x), Cells(y + 1 + rowcount01, x + fieldscount01 - 1))
Range02.Value = Application.WorksheetFunction.Transpose(array01)
Sheet01.ListObjects.Add(xlSrcRange, Range01, , xlYes).Name = tablename01
If logall = 1 Then file02.WriteLine ""
If logall = 1 Then file02.WriteLine Date & " " & Time & " END"
Else
'=== error array have onle one dimension
MsgBox ("ERROR array only have one dimension" & vbCrLf & "the dataset must have more than one line of data" & vbCrLf & "meaning, 2 dimensions")
End If
If logall = 1 Then file02.Close
If htmlout = 1 Then file03.Close
End Sub
So i decided, as i am a good guy, to reprogram my supertotal bubble sort in excel vba
Not that i am a good guy, but everyone think excel is a god, so i had to...
It will generate 3 excel tables with the dataset example (wich you can replace with a sql query)
It will still generate a log file starting with ZZZ
It will still generate a html file with all the tables
Requirements:
microsoft excel 2013
.xlsm extension (file with macro)
Activation of vba macros if excel present a warning
26/07/2015 19:48:14 Start of bubble sort example
TABLE 01 Dataset was sorted with dataset.sort by index field, alphanumeric sorting
| Index | item | quantity | description |
| 10b.2c.33b | bolt | 18 | this is a bolt |
| 11a.1c.3b | bolt | 1 | this is a bolt |
| 1a.2c.33b | bolt | 45 | this is a bolt |
| 1b.2c.33 | bolt | 12 | this is a bolt |
| 1c.2c | bolt | 5 | this is a bolt |
| 1z.10c.3b | bolt | 2 | this is a bolt |
TABLE 02 Split all the values to get only numbers and calculate a supertotal
| split01 | split02 | split03 | Number | Letter | Number | Letter | Number | Letter | Supertotal |
| 10b | 2c | 33b | 10 | 2 | 2 | 3 | 33 | 2 | 1,1003003004034E+19 |
| 11a | 1c | 3b | 11 | 1 | 1 | 3 | 3 | 2 | 1,2002002004004E+19 |
| 1a | 2c | 33b | 1 | 1 | 2 | 3 | 33 | 2 | 2,002003004034E+18 |
| 1b | 2c | 33 | 1 | 2 | 2 | 3 | 33 | 0 | 2,003003004034E+18 |
| 1c | 2c | 1 | 3 | 2 | 3 | 0 | 0 | 2,004003004001E+18 | |
| 1z | 10c | 3b | 1 | 26 | 10 | 3 | 3 | 2 | 2,027011004004E+18 |
TABLE 03 sorted after all was converted to number to make a supertotal
| Index | item | quantity | description | Supertotal verification (not in DS) |
| 1a.2c.33b | bolt | 45 | this is a bolt | 2,002003004034E+18 |
| 1b.2c.33 | bolt | 12 | this is a bolt | 2,003003004034E+18 |
| 1c.2c | bolt | 5 | this is a bolt | 2,004003004001E+18 |
| 1z.10c.3b | bolt | 2 | this is a bolt | 2,027011004004E+18 |
| 10b.2c.33b | bolt | 18 | this is a bolt | 1,1003003004034E+19 |
| 11a.1c.3b | bolt | 1 | this is a bolt | 1,2002002004004E+19 |
---------------------- excel VBA macro (alt F11, add module, insert this code) ---------------------
Sub bubblesort01()
'=== bubblesort_wildboy85.vbs
'=== requirement: wscript.exe
'=== very fast bubble sort
'=== by wildboy85 (sergefournier @ hotmail.com)
'=== objects needed
Set objFSo = CreateObject("Scripting.FileSystemObject")
Set objshe = CreateObject("WScript.Shell")
Set objNet = CreateObject("WScript.Network")
'=== register base constants
Const hkcr = &H80000000 'HKEY_CLASSES_ROOT
Const HKCU = &H80000001 'HKEY_CURRENT_USER
Const hklm = &H80000002 'HKEY_LOCAL_MACHINE
Const hku = &H80000003 'HKEY_USERS
Const hkcc = &H80000005 'HKEY_CURRENT_CONFIG
Const ForReading = 1
Const adVarChar = 200
Const MaxCharacters = 255
Const adDouble = 5
'=== actual drive, actual directory, and "\"
'thepath = Application.ActiveWorkbook.path
thepath = Application.ActiveWorkbook.FullName
p = InStrRev(thepath, "\")
basedir = Left(thepath, p)
filnam = Right(thepath, Len(thepath) - p)
'=== log what we do, in same directory as the script
logall = 1
htmlout = 1
If logall = 1 Then
'=== debug log, get this file name, remove end, change start for ZZZ
'=== remove .vbs
path01 = Left(thepath, Len(thepath) - (Len(thepath) - InStr(thepath, ".") + 1))
name01 = Right(path01, Len(path01) - InStrRev(path01, "\"))
logname01 = "zzz_" & name01 & ".txt"
'=== always have a nice error trapping
err01 = 0: err02 = ""
On Error Resume Next
Set file02 = objFSo.OpenTextFile(logname01, 2, True)
err01 = Err: err02 = Err.Description
On Error GoTo 0
End If
If err01 = 0 Then
logall = 1
Else
'=== flag to tell our program to not write in log file if there is not log file open
logall = 0 '=== could not open logfile, no log
End If
'=== html output file, we want a nice table as output
If htmlout = 1 Then
path01 = Left(thepath, Len(thepath) - (Len(thepath) - InStr(thepath, ".") + 1))
name01 = Right(path01, Len(path01) - InStrRev(path01, "\"))
logname01 = name01 & "_output.html"
'=== always have a nice error trapping
err01 = 0: err02 = ""
On Error Resume Next
Set file03 = objFSo.OpenTextFile(logname01, 2, True)
err01 = Err: err02 = Err.Description
On Error GoTo 0
End If
If err01 = 0 Then
htmlout = 1
Else
'=== flag to tell our program to not write in log file if there is not log file open
htmlout = 0 '=== could not open logfile, no log
End If
If logall = 1 Then file02.WriteLine Date & " " & Time & " START Bubble sort wildboy85"
'=== the dataset could come from a database, but here we will add data ourseleves as an example
Set dataset01 = CreateObject("ADODB.Recordset")
dataset01.Fields.Append "Index", adVarChar, MaxCharacters
If logall = 1 Then file02.WriteLine Date & " " & Time & " First field appended"
dataset01.Fields.Append "item", adVarChar, MaxCharacters
dataset01.Fields.Append "quantity", adDouble
dataset01.Fields.Append "description", adVarChar, MaxCharacters
'dataset01.Fields.Append "supertotal DS", adVarChar, MaxCharacters
dataset01.Open
'=== accessing the column by name is slow, it would be faster by name if we have big loop
dataset01.AddNew
dataset01("Index") = "11a.1c.3b"
dataset01("item") = "bolt"
dataset01("quantity") = 1
dataset01("description") = "this is a bolt"
dataset01.Update
dataset01.AddNew
dataset01("Index") = "1z.10c.3b"
dataset01("item") = "bolt"
dataset01("quantity") = 2
dataset01("description") = "this is a bolt"
dataset01.Update
dataset01.AddNew
dataset01("Index") = "1a.2c.33b"
dataset01("item") = "bolt"
dataset01("quantity") = 45
dataset01("description") = "this is a bolt"
dataset01.Update
dataset01.AddNew
dataset01("Index") = "1b.2c.33"
dataset01("item") = "bolt"
dataset01("quantity") = 12
dataset01("description") = "this is a bolt"
dataset01.Update
dataset01.AddNew
dataset01("Index") = "1c.2c"
dataset01("item") = "bolt"
dataset01("quantity") = 5
dataset01("description") = "this is a bolt"
dataset01.Update
dataset01.AddNew
dataset01("Index") = "10b.2c.33b"
dataset01("item") = "bolt"
dataset01("quantity") = 18
dataset01("description") = "this is a bolt"
dataset01.Update
dataset01.movefirst
'=== how many field? (columns)
fieldscount01 = dataset01.Fields.Count
'=== put the dataset demo in excel page (first) as a table
Dim myarray As Variant
array01 = dataset01.GetRows
'=== get number of rows (dimension 2 of the array)
On Error Resume Next
err01 = 0: err02 = ""
rowcount01 = UBound(array01, 2)
err01 = Err
err02 = Err.Description
On Error GoTo 0
If err01 = 0 Then
'=== 2 dimension in array, we continue (2 row of data is a minimum)
Set Sheet01 = Worksheets(1)
'=== delete old table01 if it exist
tablename01 = "table01"
On Error Resume Next
err01 = 0: err02 = ""
Sheet01.ListObjects(tablename01).Delete
err01 = Err
err02 = Err.Description
On Error GoTo 0
x = 1: y = 1
'=== columns names
For i = 0 To fieldscount01 - 1
Cells(y, x + i).Value = dataset01.Fields(i).Name
Next
'=== range01 include column title
Set Range01 = Range(Cells(y, x), Cells(y + 1 + rowcount01, x + fieldscount01 - 1))
'=== range02 is data only
Set Range02 = Range(Cells(y + 1, x), Cells(y + 1 + rowcount01, x + fieldscount01 - 1))
Range02.Value = Application.WorksheetFunction.Transpose(array01)
Sheet01.ListObjects.Add(xlSrcRange, Range01, , xlYes).Name = tablename01
If logall = 1 Then file02.WriteLine Date & " " & Time & " fieldcount: " & fieldscount01
If htmlout = 1 Then file03.WriteLine Date & " " & Time & " Start of bubble sort example<br><br>"
'=== this datasort will order our items badly, as if number 10 was smaller than number 1
dataset01.Sort = "index"
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' excel table02 sorted with dataset sort command (as string)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'=== read dataset that was sorted as string
array01 = dataset01.GetRows
'=== delete old table01 if it exist
tablename01 = "table02"
On Error Resume Next
err01 = 0: err02 = ""
Sheet01.ListObjects(tablename01).Delete
err01 = Err
err02 = Err.Description
On Error GoTo 0
x = 1: y = (4 + rowcount01) * 1
'=== columns names
For i = 0 To fieldscount01 - 1
Cells(y, x + i).Value = dataset01.Fields(i).Name
Next
'=== range01 include column title
Set Range01 = Range(Cells(y, x), Cells(y + 1 + rowcount01, x + fieldscount01 - 1))
'=== range02 is data only
Set Range02 = Range(Cells(y + 1, x), Cells(y + 1 + rowcount01, x + fieldscount01 - 1))
Range02.Value = Application.WorksheetFunction.Transpose(array01)
Sheet01.ListObjects.Add(xlSrcRange, Range01, , xlYes).Name = tablename01
'=== html table
If htmlout = 1 Then file03.WriteLine " TABLE 01 Dataset was sorted with dataset.sort by index field, alphanumeric sorting<br>"
If htmlout = 1 Then file03.WriteLine "<table width=""70%"" BORDERCOLOR=""black"" class=MsoTableGrid border=1 CELLSPACING=0 cellpadding=2 style='border-collapse:collapse;border:none'>"
'=== fields names as columns titles of the table
If htmlout = 1 Then file03.WriteLine "<tr>"
For i = 0 To fieldscount01 - 1
If htmlout = 1 Then file03.WriteLine "<td>" & dataset01.Fields(i).Name & "</td>"
Next
If htmlout = 1 Then file03.WriteLine "</tr>"
dataset01.movefirst
linecount = 0
Dim ara02()
Do While Not (dataset01.EOF) '=== magica loop, row
ReDim Preserve ara02(fieldscount01 - 1, linecount)
If htmlout = 1 Then file03.WriteLine "<tr>"
'=== put all values in an array, because a dataset this basic cannot switch a line of data
For i = 0 To fieldscount01 - 1
value01 = dataset01.Fields(i).Value
If IsNull(value01) Then value01 = ""
value01 = Trim(value01)
If htmlout = 1 Then file03.WriteLine "<td>" & value01 & "</td>"
ara02(i, linecount) = value01
Next
If htmlout = 1 Then file03.WriteLine "</tr>"
linecount = linecount + 1
dataset01.movenext
Loop
If htmlout = 1 Then file03.WriteLine "</table><br>"
'=== now we will split the line we will use to do the sort by number and letter (converted to numbers)
fieldtosort01 = 0 '=== field 0 contain what we want to sort, example: 1a.2b.3c
'=== we assume we will have only 3 data to sort, 1a 2b 3c
dataset01.movefirst
If htmlout = 1 Then file03.WriteLine "<br>TABLE 02 Split all the values to get only numbers and calculate a supertotal"
If htmlout = 1 Then file03.WriteLine "<table width=""70%"" BORDERCOLOR=""black"" class=MsoTableGrid border=1 CELLSPACING=0 cellpadding=2 style='border-collapse:collapse;border:none'>"
If htmlout = 1 Then file03.WriteLine "<tr><td>split01</td><td>split02</td><td>split03</td>"
If htmlout = 1 Then file03.WriteLine "<td>Number</td><td>Letter</td><td>Number</td><td>Letter</td><td>Number</td><td>Letter</td>"
If htmlout = 1 Then file03.WriteLine "<td>Supertotal</td></tr>"
'=== split the chain 1a.2b.3c by adding dots in case 2b.3c does not exist
Dim split(2)
linecount = 0
Dim ara01()
Do While Not (dataset01.EOF) '=== magica loop, row
ReDim Preserve ara01(6, linecount) '=== the last dimension can be redimensionned so we reversed the dimensions
If htmlout = 1 Then file03.WriteLine "<tr>" '=== html line change
value01 = dataset01.Fields(fieldtosort01).Value
'=== clean value in case of dbnull (dbnull cannot be processed)
If IsNull(value01) Then value01 = ""
value01 = Trim(value01)
'=== add dots at the end of string to later split at the dots and get string inbetween
'=== so if the string have no dots, the split will still work and resturn empty string instead of trying to trap errors
value01 = value01 & "...."
split(0) = Left(value01, Len(value01) - (Len(value01) - InStr(value01, ".") + 1))
leftover = Mid(value01, InStr(value01, ".") + 1, Len(value01))
split(1) = Left(leftover, Len(leftover) - (Len(leftover) - InStr(leftover, ".") + 1))
leftover = Mid(leftover, InStr(leftover, ".") + 1, Len(leftover))
split(2) = Left(leftover, Len(leftover) - (Len(leftover) - InStr(leftover, ".") + 1))
If htmlout = 1 Then file03.WriteLine "<td>" & split(0) & "</td><td>" & split(1) & "</td><td>" & split(2) & "</td>"
'=== we now do an array of 6 fields/columns
'=== field0 is 1, field1 is a, field2 is 2, field3 is b, field4 is 3, field5 is c (from 1a.2b.3c)
splitcount = 0
For x03 = 0 To 5 Step 2 'order01, order01 letter, order02, order02 letter, order03, order03 letter (letter --> integer)
'=== split the split to get 2 value, 1 for number, 1 for alpha (split the chain "1a", "2b", "3c")
data01 = Trim(split(splitcount))
len01 = Len(data01)
If len01 > 1 Then
alpha01 = 0
For i = 1 To len01
'=== is this digit alpha?
asc01 = Asc(Mid(data01, i, 1))
If (asc01 > 64 And asc01 < 91) Or (asc01 > 96 And asc01 < 123) Then
alpha01 = 1
'=== this is a letter
If i > 1 Then
val01 = CInt(Left(data01, i - 1))
Else
End If
'=== code de classement final
'if logall=1 then file02.WriteLine "value before: " & data01 & " After: " & val01 & " + " & asc01 & chr(9) & val01+asc01
If asc01 > 96 Then '=== uppercase A
asc01 = asc01 - 96
ElseIf asc01 > 64 Then '=== lowercase a
asc01 = asc01 - 64
End If
ara01(x03, linecount) = val01 '=== new ordering integer for this column
'=== create a new column to class by letter after this one
ara01(x03 + 1, linecount) = asc01
End If
Next
If alpha01 = 0 Then
'=== remove the 0 before
ara01(x03, linecount) = CInt(data01)
ara01(x03 + 1, linecount) = 0
End If
ElseIf len01 > 0 Then
'=== only 1 digit, so we assume it's a number (just to be faster)
ara01(x03, linecount) = data01 '=== new ordering integer for this column
'=== column to class by letter after this one (1 digit = no letter = 0)
ara01(x03 + 1, linecount) = 0
Else
'=== len is 0, we do nothing
ara01(x03, linecount) = 0
ara01(x03 + 1, linecount) = 0
End If
splitcount = splitcount + 1
'=== results, all numerics
If htmlout = 1 Then file03.WriteLine "<td>" & ara01(x03, linecount) & "</td><td>" & ara01(x03 + 1, linecount) & "</td>"
Next
'=== tricky part, doing a supertotal to sort only one number for all six fields/columns
supertotal = 0
mul01 = 5
super02 = ""
For x03 = 0 To 5
'=== do a super total for this line and the next for comparaison
super01 = (ara01(x03, linecount) + 1) * (1000 ^ (mul01 + 1))
supertotal = supertotal + super01
mul01 = mul01 - 1
'==== alphanumeric supertotal add 0 in front pf every digit, not working with dataset.sort either
'super02 = super02 & left("00000", 5-len((ara01(x03,linecount)+1))) & ara01(x03,linecount)+1
Next
'dataset01.fields("supertotal DS").value = super02
ara01(6, linecount) = supertotal
'dataset01.fields("supertotal DS").value = supertotal
If htmlout = 1 Then file03.WriteLine "<td>" & ara01(6, linecount) & "</td>"
linecount = linecount + 1
If htmlout = 1 Then file03.WriteLine "</tr>"
dataset01.movenext
'=== all supertotal must be computed before we can sort
'=== so this loop was to split numbers, letters and compute a supertotal with multiplicated by 1000^positioninfieldvalue(0-5) values
Loop
If htmlout = 1 Then file03.WriteLine "</table>"
'=== sorting loop, using supertotal
'=== we move through dataset at the same time we move in the array that contain supertotal at position 6
If logall = 1 Then file02.WriteLine Date & " " & Time & " START bubble sort with supertotal"
'=== using SORT command from dataset would have been easy now, but noooo, error argument, number to weird
'=== even if this a string, it cannot sort with dateset.sort command
'dataset01.Sort = "supertotal DS"
dataset01.movefirst
'set row = CreateObject("ADODB.Recordsetrow")
'=== exchange lines in dataset, is that possible?
'dataset01.rows(1) = dataset01.rows(0)
'http://www.w3schools.com/asp/ado_ref_recordset.asp
''''''''''''''''''''''''''''''''''''''''''
' bubble sort
''''''''''''''''''''''''''''''''''''''''''
Dim supertotal01(1)
ReDim ara01tempo(linecount - 1)
If logall = 1 Then file02.WriteLine Date & " " & Time & " Bubble order START"
'=== classement bulle, ligne par ligne, 6 fois
For bubble01 = linecount - 2 To 0 Step -1
For y03 = 0 To bubble01 '=== magica loop, row
'=== if supertotal after is smaller, we exchange them
If ara01(6, y03 + 1) < ara01(6, y03) Then
For x04 = 0 To fieldscount01 - 1
'=== save actual matrix x elements
ara01tempo(x04) = ara02(x04, y03)
ara02(x04, y03) = ara02(x04, y03 + 1) '=== go up one row in matrix
ara02(x04, y03 + 1) = ara01tempo(x04)
Next
'=== exchange supertotal also
supertotaltemp = ara01(6, y03)
ara01(6, y03) = ara01(6, y03 + 1)
ara01(6, y03 + 1) = supertotaltemp
End If
Next
Next
If logall = 1 Then file02.WriteLine Date & " " & Time & " END bubble sort"
'=== final result
If htmlout = 1 Then file03.WriteLine "<br>TABLE 03 sorted after all was converted to number to make a supertotal"
If htmlout = 1 Then file03.WriteLine "<br><table width=""70%"" BORDERCOLOR=""black"" class=MsoTableGrid border=1 CELLSPACING=0 cellpadding=2 style='border-collapse:collapse;border:none'>"
'=== fields names as columns titles of the table
If htmlout = 1 Then file03.WriteLine "<tr>"
For i = 0 To fieldscount01 - 1
If htmlout = 1 Then file03.WriteLine "<td>" & dataset01.Fields(i).Name & "</td>"
Next
If htmlout = 1 Then file03.WriteLine "<td>Supertotal verification (not in DS)</td>"
If htmlout = 1 Then file03.WriteLine "</tr>"
For y = 0 To linecount - 1 '=== display results after bubble sort
If htmlout = 1 Then file03.WriteLine "<tr>"
For x = 0 To fieldscount01 - 1
If htmlout = 1 Then file03.WriteLine "<td>" & ara02(x, y) & "</td>"
Next
If htmlout = 1 Then file03.WriteLine "<td>" & ara01(6, y) & "</td>"
If htmlout = 1 Then file03.WriteLine "</tr>"
Next
''''''''''''''''''''''''''''''''''''''''''''''''''''''
' table03 sorted with 6 columns (split of the first column) and super total
''''''''''''''''''''''''''''''''''''''''''''''''''''''
array01 = ara02
If htmlout = 1 Then file03.WriteLine "</table>"
'=== delete old table01 if it exist
tablename01 = "table03"
On Error Resume Next
err01 = 0: err02 = ""
Sheet01.ListObjects(tablename01).Delete
err01 = Err
err02 = Err.Description
On Error GoTo 0
x = 1: y = (4 + rowcount01) * 2
'=== columns names
For i = 0 To fieldscount01 - 1
Cells(y, x + i).Value = dataset01.Fields(i).Name
Next
'=== range01 include column title
Set Range01 = Range(Cells(y, x), Cells(y + 1 + rowcount01, x + fieldscount01 - 1))
'=== range02 is data only
Set Range02 = Range(Cells(y + 1, x), Cells(y + 1 + rowcount01, x + fieldscount01 - 1))
Range02.Value = Application.WorksheetFunction.Transpose(array01)
Sheet01.ListObjects.Add(xlSrcRange, Range01, , xlYes).Name = tablename01
If logall = 1 Then file02.WriteLine ""
If logall = 1 Then file02.WriteLine Date & " " & Time & " END"
Else
'=== error array have onle one dimension
MsgBox ("ERROR array only have one dimension" & vbCrLf & "the dataset must have more than one line of data" & vbCrLf & "meaning, 2 dimensions")
End If
If logall = 1 Then file02.Close
If htmlout = 1 Then file03.Close
End Sub
Monday, July 13, 2015
Bubble sort vbs wsh script program by wildboy85
Hello,
Sorting data is easy
Doing it faster than with a regular bubble sort method is a little harder
Aa an example, we will use something not simple
6 columns to sort with numbers and letters
1a.2b.3c
This was originally for a BOM insertion (bill of material)
There is different categories of materials, (numbers) and different sub categories (letters)
We keep numbers + 1
We change letters to numbers + 1
We calculate a super total to sort them out in one bubble pass
On bubble pass is going from element 0 to elementmax - 1
Then another loop inside that will compare element now with element after and switch them if the element after's supertotal is smaller
This is a nested loop, that will loop a lot of time of there is a lot of elements
It would have done it 6 time is we had used a classic method to sort with 6 columns, like SQL do when you use ORDER BY field01, field02, field03, field04, field05, field06
By concatening the 6 field in one supertotal, we can bubble sort only once
This is a vb script
It will generate a log.txt
and a log.html with same start name as the script
Save it with notepad.exe
26/07/2015 19:48:14 Start of bubble sort example
TABLE 01 Dataset was sorted with dataset.sort by index field, alphanumeric sorting
TABLE 02 Split all the values to get only numbers and calculate a supertotal
TABLE 03 sorted after all was converted to number to make a supertotal
-------------------------------- bubblesort.vbs -------------------
'=== bubblesort_wildboy85.vbs
'=== requirement: wscript.exe
'=== very fast bubble sort
'=== by wildboy85 (sergefournier @ hotmail.com)
'=== objects needed
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objshe = CreateObject("WScript.Shell")
Set objNet = CreateObject("WScript.Network")
'=== register base constants
Const hkcr = &H80000000 'HKEY_CLASSES_ROOT
Const HKCU = &H80000001 'HKEY_CURRENT_USER
Const hklm = &H80000002 'HKEY_LOCAL_MACHINE
Const hku = &H80000003 'HKEY_USERS
Const hkcc = &H80000005 'HKEY_CURRENT_CONFIG
Const ForReading = 1
Const adVarChar = 200
Const MaxCharacters = 255
Const adDouble = 5
'=== actual drive, actual directory, and "\"
thepath = WScript.ScriptFullName
p = instrRev(thepath,"\")
basedir = left(thepath,p)
filnam = right(thepath,len(thepath)-p)
'=== windows dir
WinDir = objfso.GetSpecialFolder(0)
'=== restart the script in 32 bits if we are on a 64 bits system
'=== some databases drivers are not yet available in 64 bits
a64 = windir & "\syswow64\wscript.exe"
if objFSO.fileEXISTS(a64) and instr(lcase(wscript.fullname),"syswow64")=0 then
'=== 64 bits system
argchain01 = ""
set args01 = Wscript.Arguments
if args01.count<>0 then
'=== when recalling this script in 32 bits, pass all the parameters
For Each arg01 in args01
argchain01 = argchain01 & " " & arg01
Next
end if
a = """" & a64 & """ """ & basedir & filnam & """" & argchain01
objshe.Run a,0, false
wscript.quit
end if
'=== log what we do, in same directory as the script
logall = 1
htmlout = 1
if logall=1 then
'=== debug log, get this file name, remove end, change start for ZZZ
'=== remove .vbs
path01 = left(thepath,len(thepath)-(len(thepath)-instr(thepath,".")+1))
name01 = right(path01,len(path01)-instrrev(path01,"\"))
logname01 = "zzz_" & name01 & ".txt"
'=== always have a nice error trapping
err01 = 0 : err02 = ""
on error resume next
Set File02 = objFSo.OpenTextFile(logname01, 2, true)
err01 = err : err02 = err.description
on error goto 0
end if
if err01 = 0 then
logall = 1
else
'=== flag to tell our program to not write in log file if there is not log file open
logall = 0 '=== could not open logfile, no log
end if
'=== html output file, we want a nice table as output
if htmlout=1 then
path01 = left(thepath,len(thepath)-(len(thepath)-instr(thepath,".")+1))
name01 = right(path01,len(path01)-instrrev(path01,"\"))
logname01 = name01 & "_output.html"
'=== always have a nice error trapping
err01 = 0 : err02 = ""
on error resume next
Set File03 = objFSo.OpenTextFile(logname01, 2, true)
err01 = err : err02 = err.description
on error goto 0
end if
if err01 = 0 then
htmlout = 1
else
'=== flag to tell our program to not write in log file if there is not log file open
htmlout = 0 '=== could not open logfile, no log
end if
if logall = 1 then file02.WriteLine date & " " & time & " START Bubble sort wildboy85"
'=== the dataset could come from a database, but here we will add data ourseleves as an example
set dataset01 = CreateObject("ADODB.Recordset")
dataset01.Fields.Append "Index", adVarChar, MaxCharacters
if logall = 1 then file02.WriteLine date & " " & time & " First field appended"
dataset01.Fields.Append "item", adVarChar, MaxCharacters
dataset01.Fields.Append "quantity", adDouble
dataset01.Fields.Append "description", adVarChar, MaxCharacters
'dataset01.Fields.Append "supertotal DS", adVarChar, MaxCharacters
dataset01.Open
'=== accessing the column by name is slow, it would be faster by name if we have big loop
dataset01.AddNew
dataset01("Index") = "1a.1c.3b"
dataset01("item") = "bolt"
dataset01("quantity") = 1
dataset01("description") = "this is a bolt"
dataset01.Update
dataset01.AddNew
dataset01("Index") = "1z.10c.3b"
dataset01("item") = "bolt"
dataset01("quantity") = 2
dataset01("description") = "this is a bolt"
dataset01.Update
dataset01.AddNew
dataset01("Index") = "1a.2c.33b"
dataset01("item") = "bolt"
dataset01("quantity") = 45
dataset01("description") = "this is a bolt"
dataset01.Update
dataset01.AddNew
dataset01("Index") = "1b.2c.33"
dataset01("item") = "bolt"
dataset01("quantity") = 12
dataset01("description") = "this is a bolt"
dataset01.Update
dataset01.AddNew
dataset01("Index") = "1c.2c"
dataset01("item") = "bolt"
dataset01("quantity") =5
dataset01("description") = "this is a bolt"
dataset01.Update
dataset01.AddNew
dataset01("Index") = "10b.2c.33b"
dataset01("item") = "bolt"
dataset01("quantity") = 18
dataset01("description") = "this is a bolt"
dataset01.Update
'=== how many field? (columns)
fieldscount01 = dataset01.fields.count
if logall = 1 then file02.WriteLine date & " " & time & " fieldcount: " & fieldscount01
if htmlout = 1 then file03.WriteLine date & " " & time & " Start of bubble sort example<br><br>"
'=== this datasort will order our items badly, as if number 10 was smaller than number 1
dataset01.Sort = "index"
'=== html table
if htmlout = 1 then file03.WriteLine " TABLE 01 Dataset was sorted with dataset.sort by index field, alphanumeric sorting<br>"
if htmlout = 1 then file03.WriteLine "<table width=""70%"" BORDERCOLOR=""black"" class=MsoTableGrid border=1 CELLSPACING=0 cellpadding=2 style='border-collapse:collapse;border:none'>"
'=== fields names as columns titles of the table
if htmlout = 1 then file03.WriteLine "<tr>"
for i = 0 to fieldscount01-1
if htmlout = 1 then file03.WriteLine "<td>" & dataset01.fields(i).name & "</td>"
next
if htmlout = 1 then file03.WriteLine "</tr>"
dataset01.movefirst
linecount = 0
do while not (dataset01.eof) '=== magica loop, row
redim preserve ara02(fieldscount01-1, linecount)
if htmlout = 1 then file03.WriteLine "<tr>"
'=== put all values in an array, because a dataset this basic cannot switch a line of data
for i = 0 to fieldscount01-1
value01 = dataset01.fields(i).value
If IsNull(value01) then value01=""
value01 = Trim(value01)
if htmlout = 1 then file03.WriteLine "<td>" & value01 & "</td>"
ara02(i, linecount) = value01
next
if htmlout = 1 then file03.WriteLine "</tr>"
linecount = linecount + 1
dataset01.movenext
loop
if htmlout = 1 then file03.WriteLine "</table><br>"
'=== now we will split the line we will use to do the sort by number and letter (converted to numbers)
fieldtosort01 = 0 '=== field 0 contain what we want to sort, example: 1a.2b.3c
'=== we assume we will have only 3 data to sort, 1a 2b 3c
dataset01.movefirst
if htmlout = 1 then file03.WriteLine "<br>TABLE 02 Split all the values to get only numbers and calculate a supertotal"
if htmlout = 1 then file03.WriteLine "<table width=""70%"" BORDERCOLOR=""black"" class=MsoTableGrid border=1 CELLSPACING=0 cellpadding=2 style='border-collapse:collapse;border:none'>"
if htmlout = 1 then file03.WriteLine "<tr><td>split01</td><td>split02</td><td>split03</td>"
if htmlout = 1 then file03.WriteLine "<td>Number</td><td>Letter</td><td>Number</td><td>Letter</td><td>Number</td><td>Letter</td>"
if htmlout = 1 then file03.WriteLine "<td>Supertotal</td></tr>"
'=== split the chain 1a.2b.3c by adding dots in case 2b.3c does not exist
dim split(2)
linecount = 0
do while not (dataset01.eof) '=== magica loop, row
redim preserve ara01(6,linecount) '=== the last dimension can be redimensionned so we reversed the dimensions
if htmlout = 1 then file03.WriteLine "<tr>" '=== html line change
value01 = dataset01.fields(fieldtosort01).value
'=== clean value in case of dbnull (dbnull cannot be processed)
If IsNull(value01) then value01=""
value01 = Trim(value01)
'=== add dots at the end of string to later split at the dots and get string inbetween
'=== so if the string have no dots, the split will still work and resturn empty string instead of trying to trap errors
value01 = value01 & "...."
split(0) = left(value01,len(value01)-(len(value01)-instr(value01,".")+1))
leftover = mid(value01,instr(value01,".")+1,len(value01))
split(1)= left(leftover,len(leftover)-(len(leftover)-instr(leftover,".")+1))
leftover = mid(leftover,instr(leftover,".")+1,len(leftover))
split(2) = left(leftover,len(leftover)-(len(leftover)-instr(leftover,".")+1))
if htmlout = 1 then file03.WriteLine "<td>" & split(0) & "</td><td>" & split(1) & "</td><td>" & split(2) & "</td>"
'=== we now do an array of 6 fields/columns
'=== field0 is 1, field1 is a, field2 is 2, field3 is b, field4 is 3, field5 is c (from 1a.2b.3c)
splitcount = 0
for x03 = 0 to 5 step 2 'order01, order01 letter, order02, order02 letter, order03, order03 letter (letter --> integer)
'=== split the split to get 2 value, 1 for number, 1 for alpha (split the chain "1a", "2b", "3c")
data01 = trim(split(splitcount))
len01 = len(data01)
if len01>1 then
alpha01 = 0
for i = 1 to len01
'=== is this digit alpha?
asc01 = ASC(mid(data01,i,1))
if (asc01>64 and ASC01<91) or (asc01 >96 and asc01 <123) then
alpha01 = 1
'=== this is a letter
if i>1 then
val01 = cint(left(data01,i-1))
else
end if
'=== code de classement final
'if logall=1 then file02.WriteLine "value before: " & data01 & " After: " & val01 & " + " & asc01 & chr(9) & val01+asc01
if asc01>96 then '=== uppercase A
asc01 = asc01 - 96
elseif asc01>64 then '=== lowercase a
asc01 = asc01 - 64
end if
ara01(x03,linecount) = val01 '=== new ordering integer for this column
'=== create a new column to class by letter after this one
ara01(x03+1,linecount) = asc01
end if
next
if alpha01 = 0 then
'=== remove the 0 before
ara01(x03,linecount) = cint(data01)
ara01(x03+1,linecount) = 0
end if
elseif len01>0 then
'=== only 1 digit, so we assume it's a number (just to be faster)
ara01(x03,linecount) = data01 '=== new ordering integer for this column
'=== column to class by letter after this one (1 digit = no letter = 0)
ara01(x03+1,linecount) = 0
else
'=== len is 0, we do nothing
ara01(x03,linecount) = 0
ara01(x03+1,linecount) = 0
end if
splitcount = splitcount + 1
'=== results, all numerics
if htmlout = 1 then file03.WriteLine "<td>" & ara01(x03,linecount) & "</td><td>" & ara01(x03+1,linecount) & "</td>"
next
'=== tricky part, doing a supertotal to sort only one number for all six fields/columns
supertotal = 0
mul01 = 5
super02 = ""
for x03 = 0 to 5
'=== do a super total for this line and the next for comparaison
super01 = (ara01(x03,linecount)+1)*(1000^(mul01+1))
supertotal = supertotal + super01
mul01 = mul01 - 1
'==== alphanumeric supertotal add 0 in front pf every digit, not working with dataset.sort either
'super02 = super02 & left("00000", 5-len((ara01(x03,linecount)+1))) & ara01(x03,linecount)+1
next
'dataset01.fields("supertotal DS").value = super02
ara01(6,linecount) = supertotal
'dataset01.fields("supertotal DS").value = supertotal
if htmlout = 1 then file03.WriteLine "<td>" & ara01(6,linecount) & "</td>"
linecount = linecount + 1
if htmlout = 1 then file03.WriteLine "</tr>"
dataset01.movenext
'=== all supertotal must be computed before we can sort
'=== so this loop was to split numbers, letters and compute a supertotal with multiplicated by 1000^positioninfieldvalue(0-5) values
loop
if htmlout = 1 then file03.WriteLine "</table>"
'=== sorting loop, using supertotal
'=== we move through dataset at the same time we move in the array that contain supertotal at position 6
if logall = 1 then file02.WriteLine date & " " & time & " START bubble sort with supertotal"
'=== using SORT command from dataset would have been easy now, but noooo, error argument, number to weird
'=== even if this a string, it cannot sort with dateset.sort command
'dataset01.Sort = "supertotal DS"
dataset01.movefirst
'set row = CreateObject("ADODB.Recordsetrow")
'=== exchange lines in dataset, is that possible?
'dataset01.rows(1) = dataset01.rows(0)
'http://www.w3schools.com/asp/ado_ref_recordset.asp
''''''''''''''''''''''''''''''''''''''''''
' bubble sort
''''''''''''''''''''''''''''''''''''''''''
dim supertotal01(1)
redim ara01tempo(linecount-1)
if logall=1 then file02.WriteLine date & " " & time & " Bubble order START"
'=== classement bulle, ligne par ligne, 6 fois
for bubble01 = linecount-2 to 0 step -1
for y03 = 0 to bubble01 '=== magica loop, row
'=== if supertotal after is smaller, we exchange them
if ara01(6,y03+1) < ara01(6,y03) then
for x04 = 0 to fieldscount01-1
'=== save actual matrix x elements
ara01tempo(x04) = ara02(x04,y03)
ara02(x04,y03) = ara02(x04,y03+1) '=== go up one row in matrix
ara02(x04,y03+1) = ara01tempo(x04)
next
'=== exchange supertotal also
supertotaltemp = ara01(6,y03)
ara01(6,y03) = ara01(6,y03+1)
ara01(6,y03+1) = supertotaltemp
end if
next
next
if logall = 1 then file02.WriteLine date & " " & time & " END bubble sort"
'=== final result
if htmlout = 1 then file03.WriteLine "<br>TABLE 03 sorted after all was converted to number to make a supertotal"
if htmlout = 1 then file03.WriteLine "<br><table width=""70%"" BORDERCOLOR=""black"" class=MsoTableGrid border=1 CELLSPACING=0 cellpadding=2 style='border-collapse:collapse;border:none'>"
'=== fields names as columns titles of the table
if htmlout = 1 then file03.WriteLine "<tr>"
for i = 0 to fieldscount01-1
if htmlout = 1 then file03.WriteLine "<td>" & dataset01.fields(i).name & "</td>"
next
if htmlout = 1 then file03.WriteLine "<td>Supertotal verification (not in DS)</td>"
if htmlout = 1 then file03.WriteLine "</tr>"
for y = 0 to linecount-1 '=== display results after bubble sort
if htmlout = 1 then file03.WriteLine "<tr>"
for x = 0 to fieldscount01-1
if htmlout = 1 then file03.WriteLine "<td>" & ara02(x,y) & "</td>"
next
if htmlout = 1 then file03.WriteLine "<td>" & ara01(6,y) & "</td>"
if htmlout = 1 then file03.WriteLine "</tr>"
next
if htmlout = 1 then file03.WriteLine "</table>"
if logall = 1 then file02.WriteLine ""
if logall = 1 then file02.WriteLine date & " " & time & " END"
if logall = 1 then file02.close
if htmlout = 1 then file03.close
Sorting data is easy
Doing it faster than with a regular bubble sort method is a little harder
Aa an example, we will use something not simple
6 columns to sort with numbers and letters
1a.2b.3c
This was originally for a BOM insertion (bill of material)
There is different categories of materials, (numbers) and different sub categories (letters)
We keep numbers + 1
We change letters to numbers + 1
We calculate a super total to sort them out in one bubble pass
On bubble pass is going from element 0 to elementmax - 1
Then another loop inside that will compare element now with element after and switch them if the element after's supertotal is smaller
This is a nested loop, that will loop a lot of time of there is a lot of elements
It would have done it 6 time is we had used a classic method to sort with 6 columns, like SQL do when you use ORDER BY field01, field02, field03, field04, field05, field06
By concatening the 6 field in one supertotal, we can bubble sort only once
This is a vb script
It will generate a log.txt
and a log.html with same start name as the script
Save it with notepad.exe
26/07/2015 19:48:14 Start of bubble sort example
TABLE 01 Dataset was sorted with dataset.sort by index field, alphanumeric sorting
| Index | item | quantity | description |
| 10b.2c.33b | bolt | 18 | this is a bolt |
| 11a.1c.3b | bolt | 1 | this is a bolt |
| 1a.2c.33b | bolt | 45 | this is a bolt |
| 1b.2c.33 | bolt | 12 | this is a bolt |
| 1c.2c | bolt | 5 | this is a bolt |
| 1z.10c.3b | bolt | 2 | this is a bolt |
TABLE 02 Split all the values to get only numbers and calculate a supertotal
| split01 | split02 | split03 | Number | Letter | Number | Letter | Number | Letter | Supertotal |
| 10b | 2c | 33b | 10 | 2 | 2 | 3 | 33 | 2 | 1,1003003004034E+19 |
| 11a | 1c | 3b | 11 | 1 | 1 | 3 | 3 | 2 | 1,2002002004004E+19 |
| 1a | 2c | 33b | 1 | 1 | 2 | 3 | 33 | 2 | 2,002003004034E+18 |
| 1b | 2c | 33 | 1 | 2 | 2 | 3 | 33 | 0 | 2,003003004034E+18 |
| 1c | 2c | 1 | 3 | 2 | 3 | 0 | 0 | 2,004003004001E+18 | |
| 1z | 10c | 3b | 1 | 26 | 10 | 3 | 3 | 2 | 2,027011004004E+18 |
TABLE 03 sorted after all was converted to number to make a supertotal
| Index | item | quantity | description | Supertotal verification (not in DS) |
| 1a.2c.33b | bolt | 45 | this is a bolt | 2,002003004034E+18 |
| 1b.2c.33 | bolt | 12 | this is a bolt | 2,003003004034E+18 |
| 1c.2c | bolt | 5 | this is a bolt | 2,004003004001E+18 |
| 1z.10c.3b | bolt | 2 | this is a bolt | 2,027011004004E+18 |
| 10b.2c.33b | bolt | 18 | this is a bolt | 1,1003003004034E+19 |
| 11a.1c.3b | bolt | 1 | this is a bolt | 1,2002002004004E+19 |
-------------------------------- bubblesort.vbs -------------------
'=== bubblesort_wildboy85.vbs
'=== requirement: wscript.exe
'=== very fast bubble sort
'=== by wildboy85 (sergefournier @ hotmail.com)
'=== objects needed
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objshe = CreateObject("WScript.Shell")
Set objNet = CreateObject("WScript.Network")
'=== register base constants
Const hkcr = &H80000000 'HKEY_CLASSES_ROOT
Const HKCU = &H80000001 'HKEY_CURRENT_USER
Const hklm = &H80000002 'HKEY_LOCAL_MACHINE
Const hku = &H80000003 'HKEY_USERS
Const hkcc = &H80000005 'HKEY_CURRENT_CONFIG
Const ForReading = 1
Const adVarChar = 200
Const MaxCharacters = 255
Const adDouble = 5
'=== actual drive, actual directory, and "\"
thepath = WScript.ScriptFullName
p = instrRev(thepath,"\")
basedir = left(thepath,p)
filnam = right(thepath,len(thepath)-p)
'=== windows dir
WinDir = objfso.GetSpecialFolder(0)
'=== restart the script in 32 bits if we are on a 64 bits system
'=== some databases drivers are not yet available in 64 bits
a64 = windir & "\syswow64\wscript.exe"
if objFSO.fileEXISTS(a64) and instr(lcase(wscript.fullname),"syswow64")=0 then
'=== 64 bits system
argchain01 = ""
set args01 = Wscript.Arguments
if args01.count<>0 then
'=== when recalling this script in 32 bits, pass all the parameters
For Each arg01 in args01
argchain01 = argchain01 & " " & arg01
Next
end if
a = """" & a64 & """ """ & basedir & filnam & """" & argchain01
objshe.Run a,0, false
wscript.quit
end if
'=== log what we do, in same directory as the script
logall = 1
htmlout = 1
if logall=1 then
'=== debug log, get this file name, remove end, change start for ZZZ
'=== remove .vbs
path01 = left(thepath,len(thepath)-(len(thepath)-instr(thepath,".")+1))
name01 = right(path01,len(path01)-instrrev(path01,"\"))
logname01 = "zzz_" & name01 & ".txt"
'=== always have a nice error trapping
err01 = 0 : err02 = ""
on error resume next
Set File02 = objFSo.OpenTextFile(logname01, 2, true)
err01 = err : err02 = err.description
on error goto 0
end if
if err01 = 0 then
logall = 1
else
'=== flag to tell our program to not write in log file if there is not log file open
logall = 0 '=== could not open logfile, no log
end if
'=== html output file, we want a nice table as output
if htmlout=1 then
path01 = left(thepath,len(thepath)-(len(thepath)-instr(thepath,".")+1))
name01 = right(path01,len(path01)-instrrev(path01,"\"))
logname01 = name01 & "_output.html"
'=== always have a nice error trapping
err01 = 0 : err02 = ""
on error resume next
Set File03 = objFSo.OpenTextFile(logname01, 2, true)
err01 = err : err02 = err.description
on error goto 0
end if
if err01 = 0 then
htmlout = 1
else
'=== flag to tell our program to not write in log file if there is not log file open
htmlout = 0 '=== could not open logfile, no log
end if
if logall = 1 then file02.WriteLine date & " " & time & " START Bubble sort wildboy85"
'=== the dataset could come from a database, but here we will add data ourseleves as an example
set dataset01 = CreateObject("ADODB.Recordset")
dataset01.Fields.Append "Index", adVarChar, MaxCharacters
if logall = 1 then file02.WriteLine date & " " & time & " First field appended"
dataset01.Fields.Append "item", adVarChar, MaxCharacters
dataset01.Fields.Append "quantity", adDouble
dataset01.Fields.Append "description", adVarChar, MaxCharacters
'dataset01.Fields.Append "supertotal DS", adVarChar, MaxCharacters
dataset01.Open
'=== accessing the column by name is slow, it would be faster by name if we have big loop
dataset01.AddNew
dataset01("Index") = "1a.1c.3b"
dataset01("item") = "bolt"
dataset01("quantity") = 1
dataset01("description") = "this is a bolt"
dataset01.Update
dataset01.AddNew
dataset01("Index") = "1z.10c.3b"
dataset01("item") = "bolt"
dataset01("quantity") = 2
dataset01("description") = "this is a bolt"
dataset01.Update
dataset01.AddNew
dataset01("Index") = "1a.2c.33b"
dataset01("item") = "bolt"
dataset01("quantity") = 45
dataset01("description") = "this is a bolt"
dataset01.Update
dataset01.AddNew
dataset01("Index") = "1b.2c.33"
dataset01("item") = "bolt"
dataset01("quantity") = 12
dataset01("description") = "this is a bolt"
dataset01.Update
dataset01.AddNew
dataset01("Index") = "1c.2c"
dataset01("item") = "bolt"
dataset01("quantity") =5
dataset01("description") = "this is a bolt"
dataset01.Update
dataset01.AddNew
dataset01("Index") = "10b.2c.33b"
dataset01("item") = "bolt"
dataset01("quantity") = 18
dataset01("description") = "this is a bolt"
dataset01.Update
'=== how many field? (columns)
fieldscount01 = dataset01.fields.count
if logall = 1 then file02.WriteLine date & " " & time & " fieldcount: " & fieldscount01
if htmlout = 1 then file03.WriteLine date & " " & time & " Start of bubble sort example<br><br>"
'=== this datasort will order our items badly, as if number 10 was smaller than number 1
dataset01.Sort = "index"
'=== html table
if htmlout = 1 then file03.WriteLine " TABLE 01 Dataset was sorted with dataset.sort by index field, alphanumeric sorting<br>"
if htmlout = 1 then file03.WriteLine "<table width=""70%"" BORDERCOLOR=""black"" class=MsoTableGrid border=1 CELLSPACING=0 cellpadding=2 style='border-collapse:collapse;border:none'>"
'=== fields names as columns titles of the table
if htmlout = 1 then file03.WriteLine "<tr>"
for i = 0 to fieldscount01-1
if htmlout = 1 then file03.WriteLine "<td>" & dataset01.fields(i).name & "</td>"
next
if htmlout = 1 then file03.WriteLine "</tr>"
dataset01.movefirst
linecount = 0
do while not (dataset01.eof) '=== magica loop, row
redim preserve ara02(fieldscount01-1, linecount)
if htmlout = 1 then file03.WriteLine "<tr>"
'=== put all values in an array, because a dataset this basic cannot switch a line of data
for i = 0 to fieldscount01-1
value01 = dataset01.fields(i).value
If IsNull(value01) then value01=""
value01 = Trim(value01)
if htmlout = 1 then file03.WriteLine "<td>" & value01 & "</td>"
ara02(i, linecount) = value01
next
if htmlout = 1 then file03.WriteLine "</tr>"
linecount = linecount + 1
dataset01.movenext
loop
if htmlout = 1 then file03.WriteLine "</table><br>"
'=== now we will split the line we will use to do the sort by number and letter (converted to numbers)
fieldtosort01 = 0 '=== field 0 contain what we want to sort, example: 1a.2b.3c
'=== we assume we will have only 3 data to sort, 1a 2b 3c
dataset01.movefirst
if htmlout = 1 then file03.WriteLine "<br>TABLE 02 Split all the values to get only numbers and calculate a supertotal"
if htmlout = 1 then file03.WriteLine "<table width=""70%"" BORDERCOLOR=""black"" class=MsoTableGrid border=1 CELLSPACING=0 cellpadding=2 style='border-collapse:collapse;border:none'>"
if htmlout = 1 then file03.WriteLine "<tr><td>split01</td><td>split02</td><td>split03</td>"
if htmlout = 1 then file03.WriteLine "<td>Number</td><td>Letter</td><td>Number</td><td>Letter</td><td>Number</td><td>Letter</td>"
if htmlout = 1 then file03.WriteLine "<td>Supertotal</td></tr>"
'=== split the chain 1a.2b.3c by adding dots in case 2b.3c does not exist
dim split(2)
linecount = 0
do while not (dataset01.eof) '=== magica loop, row
redim preserve ara01(6,linecount) '=== the last dimension can be redimensionned so we reversed the dimensions
if htmlout = 1 then file03.WriteLine "<tr>" '=== html line change
value01 = dataset01.fields(fieldtosort01).value
'=== clean value in case of dbnull (dbnull cannot be processed)
If IsNull(value01) then value01=""
value01 = Trim(value01)
'=== add dots at the end of string to later split at the dots and get string inbetween
'=== so if the string have no dots, the split will still work and resturn empty string instead of trying to trap errors
value01 = value01 & "...."
split(0) = left(value01,len(value01)-(len(value01)-instr(value01,".")+1))
leftover = mid(value01,instr(value01,".")+1,len(value01))
split(1)= left(leftover,len(leftover)-(len(leftover)-instr(leftover,".")+1))
leftover = mid(leftover,instr(leftover,".")+1,len(leftover))
split(2) = left(leftover,len(leftover)-(len(leftover)-instr(leftover,".")+1))
if htmlout = 1 then file03.WriteLine "<td>" & split(0) & "</td><td>" & split(1) & "</td><td>" & split(2) & "</td>"
'=== we now do an array of 6 fields/columns
'=== field0 is 1, field1 is a, field2 is 2, field3 is b, field4 is 3, field5 is c (from 1a.2b.3c)
splitcount = 0
for x03 = 0 to 5 step 2 'order01, order01 letter, order02, order02 letter, order03, order03 letter (letter --> integer)
'=== split the split to get 2 value, 1 for number, 1 for alpha (split the chain "1a", "2b", "3c")
data01 = trim(split(splitcount))
len01 = len(data01)
if len01>1 then
alpha01 = 0
for i = 1 to len01
'=== is this digit alpha?
asc01 = ASC(mid(data01,i,1))
if (asc01>64 and ASC01<91) or (asc01 >96 and asc01 <123) then
alpha01 = 1
'=== this is a letter
if i>1 then
val01 = cint(left(data01,i-1))
else
end if
'=== code de classement final
'if logall=1 then file02.WriteLine "value before: " & data01 & " After: " & val01 & " + " & asc01 & chr(9) & val01+asc01
if asc01>96 then '=== uppercase A
asc01 = asc01 - 96
elseif asc01>64 then '=== lowercase a
asc01 = asc01 - 64
end if
ara01(x03,linecount) = val01 '=== new ordering integer for this column
'=== create a new column to class by letter after this one
ara01(x03+1,linecount) = asc01
end if
next
if alpha01 = 0 then
'=== remove the 0 before
ara01(x03,linecount) = cint(data01)
ara01(x03+1,linecount) = 0
end if
elseif len01>0 then
'=== only 1 digit, so we assume it's a number (just to be faster)
ara01(x03,linecount) = data01 '=== new ordering integer for this column
'=== column to class by letter after this one (1 digit = no letter = 0)
ara01(x03+1,linecount) = 0
else
'=== len is 0, we do nothing
ara01(x03,linecount) = 0
ara01(x03+1,linecount) = 0
end if
splitcount = splitcount + 1
'=== results, all numerics
if htmlout = 1 then file03.WriteLine "<td>" & ara01(x03,linecount) & "</td><td>" & ara01(x03+1,linecount) & "</td>"
next
'=== tricky part, doing a supertotal to sort only one number for all six fields/columns
supertotal = 0
mul01 = 5
super02 = ""
for x03 = 0 to 5
'=== do a super total for this line and the next for comparaison
super01 = (ara01(x03,linecount)+1)*(1000^(mul01+1))
supertotal = supertotal + super01
mul01 = mul01 - 1
'==== alphanumeric supertotal add 0 in front pf every digit, not working with dataset.sort either
'super02 = super02 & left("00000", 5-len((ara01(x03,linecount)+1))) & ara01(x03,linecount)+1
next
'dataset01.fields("supertotal DS").value = super02
ara01(6,linecount) = supertotal
'dataset01.fields("supertotal DS").value = supertotal
if htmlout = 1 then file03.WriteLine "<td>" & ara01(6,linecount) & "</td>"
linecount = linecount + 1
if htmlout = 1 then file03.WriteLine "</tr>"
dataset01.movenext
'=== all supertotal must be computed before we can sort
'=== so this loop was to split numbers, letters and compute a supertotal with multiplicated by 1000^positioninfieldvalue(0-5) values
loop
if htmlout = 1 then file03.WriteLine "</table>"
'=== sorting loop, using supertotal
'=== we move through dataset at the same time we move in the array that contain supertotal at position 6
if logall = 1 then file02.WriteLine date & " " & time & " START bubble sort with supertotal"
'=== using SORT command from dataset would have been easy now, but noooo, error argument, number to weird
'=== even if this a string, it cannot sort with dateset.sort command
'dataset01.Sort = "supertotal DS"
dataset01.movefirst
'set row = CreateObject("ADODB.Recordsetrow")
'=== exchange lines in dataset, is that possible?
'dataset01.rows(1) = dataset01.rows(0)
'http://www.w3schools.com/asp/ado_ref_recordset.asp
''''''''''''''''''''''''''''''''''''''''''
' bubble sort
''''''''''''''''''''''''''''''''''''''''''
dim supertotal01(1)
redim ara01tempo(linecount-1)
if logall=1 then file02.WriteLine date & " " & time & " Bubble order START"
'=== classement bulle, ligne par ligne, 6 fois
for bubble01 = linecount-2 to 0 step -1
for y03 = 0 to bubble01 '=== magica loop, row
'=== if supertotal after is smaller, we exchange them
if ara01(6,y03+1) < ara01(6,y03) then
for x04 = 0 to fieldscount01-1
'=== save actual matrix x elements
ara01tempo(x04) = ara02(x04,y03)
ara02(x04,y03) = ara02(x04,y03+1) '=== go up one row in matrix
ara02(x04,y03+1) = ara01tempo(x04)
next
'=== exchange supertotal also
supertotaltemp = ara01(6,y03)
ara01(6,y03) = ara01(6,y03+1)
ara01(6,y03+1) = supertotaltemp
end if
next
next
if logall = 1 then file02.WriteLine date & " " & time & " END bubble sort"
'=== final result
if htmlout = 1 then file03.WriteLine "<br>TABLE 03 sorted after all was converted to number to make a supertotal"
if htmlout = 1 then file03.WriteLine "<br><table width=""70%"" BORDERCOLOR=""black"" class=MsoTableGrid border=1 CELLSPACING=0 cellpadding=2 style='border-collapse:collapse;border:none'>"
'=== fields names as columns titles of the table
if htmlout = 1 then file03.WriteLine "<tr>"
for i = 0 to fieldscount01-1
if htmlout = 1 then file03.WriteLine "<td>" & dataset01.fields(i).name & "</td>"
next
if htmlout = 1 then file03.WriteLine "<td>Supertotal verification (not in DS)</td>"
if htmlout = 1 then file03.WriteLine "</tr>"
for y = 0 to linecount-1 '=== display results after bubble sort
if htmlout = 1 then file03.WriteLine "<tr>"
for x = 0 to fieldscount01-1
if htmlout = 1 then file03.WriteLine "<td>" & ara02(x,y) & "</td>"
next
if htmlout = 1 then file03.WriteLine "<td>" & ara01(6,y) & "</td>"
if htmlout = 1 then file03.WriteLine "</tr>"
next
if htmlout = 1 then file03.WriteLine "</table>"
if logall = 1 then file02.WriteLine ""
if logall = 1 then file02.WriteLine date & " " & time & " END"
if logall = 1 then file02.close
if htmlout = 1 then file03.close
Sunday, January 18, 2015
PHP basic page - learning to program php - lesson 01
Hello,
I started to program some php to make a web site with a database
To do so you need to install 2 programs.
For apache server and my sql server:
wampserver2.5-Apache-2.4.9-Mysql-5.6.17-php5.5.12-64b
To edit your mysql tables:
SQLyog-11.5.1-0.x64Community
Also, the web server will not start if SKYPE is open and use port 80
(or anything that use port 80 for that matter)
Installing WAMP will create in your C drive a folder like this: C:\wamp
Inside it, a web folder: C:\wamp\www
index.php is the starting file for the server
You should add a sub folder for a project you make like this:
C:\wamp\www\project02
Then in this folder create a index.php file with notepad2 (for the colors)
Inside index.php you can have a HTML part:
------------------------- index.php file start ----------------------------
<!DOCTYPE html>
<html:html>
<html:body>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1" /><div align="center">
<title>my web site</title>
</head>
</html:body>
</html:html>
<html>
<body>
------------ comments start -------------
Now, since we are not newbs, we want to use inner html to build our page dynamically
So we insert a DIV zone called "zoneright"
Then a java script that will use inner html to update the content of that zone
Then a OD_flush et and flush to refresh the content (empty any buffer that was sent to your browser and apply change) without reloading the page
------------ comments end -------------
<?php
// $h is a variable to put html content
$h= "Nice web page that update dynamically";
// create a DIV zone with a name to use innrehtml later
$h.="<div id='zoneright'></div>";
// push the html content in the browser
echo $h;
// dynamic data to insert into the inner html zone "zoneright"
$h2 = "test 44";
// send a java script to the browser that will update the innerhtml zone for us
// syntax tip: before $h2 is a double quote " then a single quote '
// syntax tip: after $h2 is a single quote ' then a double quote "
echo '<script type="text/javascript">
document.getElementById("zoneright").innerHTML = "'.$h2.'";
</script>';
// empty all browser buffers to update the web page right now
ob_flush();
flush();
// wait 2 sec
sleep (2);
// new content
$h2 = "test 45";
// send another script to change inner html content for the new data in $h2
echo '<script type="text/javascript">
document.getElementById("zoneright").innerHTML = "'.$h2.'";
</script>';
// force brower to update right now again
ob_flush();
flush();
?>
-------------------- index.php file end ---------------------------
Now, save the index.php file
And load the local web site in your browser
http://localhost/project02
Now you learned to do some php, innerhtml and force a refresh on a page
Next, we will learn to use buttons to update the page content
I started to program some php to make a web site with a database
To do so you need to install 2 programs.
For apache server and my sql server:
wampserver2.5-Apache-2.4.9-Mysql-5.6.17-php5.5.12-64b
To edit your mysql tables:
SQLyog-11.5.1-0.x64Community
Also, the web server will not start if SKYPE is open and use port 80
(or anything that use port 80 for that matter)
Installing WAMP will create in your C drive a folder like this: C:\wamp
Inside it, a web folder: C:\wamp\www
index.php is the starting file for the server
You should add a sub folder for a project you make like this:
C:\wamp\www\project02
Then in this folder create a index.php file with notepad2 (for the colors)
Inside index.php you can have a HTML part:
------------------------- index.php file start ----------------------------
<!DOCTYPE html>
<html:html>
<html:body>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1" /><div align="center">
<title>my web site</title>
</head>
</html:body>
</html:html>
<html>
<body>
------------ comments start -------------
Now, since we are not newbs, we want to use inner html to build our page dynamically
So we insert a DIV zone called "zoneright"
Then a java script that will use inner html to update the content of that zone
Then a OD_flush et and flush to refresh the content (empty any buffer that was sent to your browser and apply change) without reloading the page
------------ comments end -------------
<?php
// $h is a variable to put html content
$h= "Nice web page that update dynamically";
// create a DIV zone with a name to use innrehtml later
$h.="<div id='zoneright'></div>";
// push the html content in the browser
echo $h;
// dynamic data to insert into the inner html zone "zoneright"
$h2 = "test 44";
// send a java script to the browser that will update the innerhtml zone for us
// syntax tip: before $h2 is a double quote " then a single quote '
// syntax tip: after $h2 is a single quote ' then a double quote "
echo '<script type="text/javascript">
document.getElementById("zoneright").innerHTML = "'.$h2.'";
</script>';
// empty all browser buffers to update the web page right now
ob_flush();
flush();
// wait 2 sec
sleep (2);
// new content
$h2 = "test 45";
// send another script to change inner html content for the new data in $h2
echo '<script type="text/javascript">
document.getElementById("zoneright").innerHTML = "'.$h2.'";
</script>';
// force brower to update right now again
ob_flush();
flush();
?>
-------------------- index.php file end ---------------------------
Now, save the index.php file
And load the local web site in your browser
http://localhost/project02
Now you learned to do some php, innerhtml and force a refresh on a page
Next, we will learn to use buttons to update the page content
Thursday, December 18, 2014
sub et function
Les subs (mot clef: SUB) et les functions (mot clef: FUNCTION)
La différence entre un sub et une function
Le sub (sous programme) ne retourne pas de valeur
La function (fonction) retourne une valeur, un ensemble de valeur identique (array) ou une structure de valeurs
À l'intérieur de la function, cette valeur est contenue dans une variable qui a le même nom que la function
Quand la valeur est retournée au sub qui l'a appelée, elle est injectée dans la variable qui a servi à appeler la function
Exemple:
sub programmeprincipal
'=== ici on apelle la function "calculatethis" en lui envoyant deux valeur à calculer
valeur01 = calculatethis(5,20)
msgbox(valeur01)
end sub
function calculatethis(valeur10, valeur20)
'=== calculatethis est la valeur retournée au sub car elle a le même nom que la function
calculatethis = valeur10 + valeur20
end function
Le programme principal est toujours un sub (de préférence)
Le sub apparait dans la liste des programme macros à exécuter si dans excel, on appuie ALT F8
Le function n'apparait pas, car ce sont les sub qui utilisent les functions, pas l'utilisateur humain
Donc faire des function pour tous les traitements à faire que l'usager n'a pas besoin de faire directement est une bonne méthode pour garder le menu ALT F8 "propre" (dans excel vba)
Excel traite séquentiellement les instructions du sub, et quand il atteint end sub, il a terminé
Il ne va pas traiter la function, parce qu'il sait que celle-ci sera appelé par le sub
Les instruments de base de la programmation sont bien sûr les variables (algèbre), mais aussi variables en tableau (array) et les boucles
Le tableau 1 dimension est un groupe de variables séquentiel
Exemple:
sub programmeprincipal
'=== array01 est un groupe de valeurs qui contient deux valeurs
array01 = array(5, 20)
valeur01 = calculatethis(array01)
msgbox(valeur01)
end sub
function calculatethis(array10)
for each element01 in array10
calculatethis= calculatethis+ element01
next
end function
"For each" va boucler jusqu'à ce que chaque valeur dans le tableau ait été traitée
Chaque valeur sera déposée dans "element01" à chaque itération de la boucle
La boucle se répétera tant qu'il y a des valeurs dans "array10"
La différence entre un sub et une function
Le sub (sous programme) ne retourne pas de valeur
La function (fonction) retourne une valeur, un ensemble de valeur identique (array) ou une structure de valeurs
À l'intérieur de la function, cette valeur est contenue dans une variable qui a le même nom que la function
Quand la valeur est retournée au sub qui l'a appelée, elle est injectée dans la variable qui a servi à appeler la function
Exemple:
sub programmeprincipal
'=== ici on apelle la function "calculatethis" en lui envoyant deux valeur à calculer
valeur01 = calculatethis(5,20)
msgbox(valeur01)
end sub
function calculatethis(valeur10, valeur20)
'=== calculatethis est la valeur retournée au sub car elle a le même nom que la function
calculatethis = valeur10 + valeur20
end function
Le programme principal est toujours un sub (de préférence)
Le sub apparait dans la liste des programme macros à exécuter si dans excel, on appuie ALT F8
Le function n'apparait pas, car ce sont les sub qui utilisent les functions, pas l'utilisateur humain
Donc faire des function pour tous les traitements à faire que l'usager n'a pas besoin de faire directement est une bonne méthode pour garder le menu ALT F8 "propre" (dans excel vba)
Excel traite séquentiellement les instructions du sub, et quand il atteint end sub, il a terminé
Il ne va pas traiter la function, parce qu'il sait que celle-ci sera appelé par le sub
Les instruments de base de la programmation sont bien sûr les variables (algèbre), mais aussi variables en tableau (array) et les boucles
Le tableau 1 dimension est un groupe de variables séquentiel
Exemple:
sub programmeprincipal
'=== array01 est un groupe de valeurs qui contient deux valeurs
array01 = array(5, 20)
valeur01 = calculatethis(array01)
msgbox(valeur01)
end sub
function calculatethis(array10)
for each element01 in array10
calculatethis= calculatethis+ element01
next
end function
"For each" va boucler jusqu'à ce que chaque valeur dans le tableau ait été traitée
Chaque valeur sera déposée dans "element01" à chaque itération de la boucle
La boucle se répétera tant qu'il y a des valeurs dans "array10"
Subscribe to:
Posts (Atom)