VBAでPOSTしてPHPでJANを発行してMySQLに登録する

<?php

/*
create database vba_post;
use vba_post
create table post_tb(id int not null primary key auto_increment, value varchar(255));
*/

Application::main();

class Application{
	
	static function con(){
		return new PDO("mysql:dbname=vba_post;host=localhost;charset=utf8","root","123");
	}
	
	static function h($s){
		return htmlspecialchars ($s,ENT_QUOTES);
	}
	
	static function jan($s){
		
		$buf = "20" . str_pad($s, 10, "0", STR_PAD_LEFT);
		$o = $buf[0] + $buf[2] + $buf[4] + $buf[6] + $buf[8] + $buf[10];
		$e = $buf[1] + $buf[3] + $buf[5] + $buf[7] + $buf[9] + $buf[11];
		$e *= 3;
		$digi = 10 - substr(($e + $o),-1);
		if($digi == 10){ $digi = 0; }
		
		return $buf . $digi;
	}
	
	static function main(){
		
		if(array_key_exists("update",$_POST) && $_POST["update"] === "save"){
			
			$d = self::con();
			$d->setAttribute(PDO::ATTR_ERRMODE, PDO::ERRMODE_EXCEPTION);
			
			try{
				
				$d->beginTransaction();

				$s = $d->query("show table status like 'post_tb'"); 
				$id = $s->fetch();

				$p = $d->prepare("insert into post_tb (value) values (:v)");
				$p->execute(array(
					":v" => self::h($_POST['value'])
				));

				$d->commit();
				echo self::jan($id['Auto_increment']);
				
			}catch(PDOException $e){
				
				$d->rollback();
				echo "false";
				
			}	
			
		}
		
	}
	
}

1

2

3

4

5

6

7

8

9

10

11

12

13

14

15

16

17

18

19

20

21

22

23

24

25

26

27

28

29

30

31

32

33

34

35

36

37

38

39

40

41

42

43

44

45

46

47

48

49

50

51

52

53

54

55

56

57

58

59

60

61

62

63

64

65

66

<?php

/*

create database vba_post;

use vba_post

create table post_tb(id int not null primary key auto_increment, value varchar(255));

*/

Application::main();

class Application{

static function con(){

return new PDO("mysql:dbname=vba_post;host=localhost;charset=utf8","root","123");

}

static function h($s){

return htmlspecialchars ($s,ENT_QUOTES);

}

static function jan($s){

$buf = "20" . str_pad($s, 10, "0", STR_PAD_LEFT);

$o = $buf[0] + $buf[2] + $buf[4] + $buf[6] + $buf[8] + $buf[10];

$e = $buf[1] + $buf[3] + $buf[5] + $buf[7] + $buf[9] + $buf[11];

$e *= 3;

$digi = 10 - substr(($e + $o),-1);

if($digi == 10){ $digi = 0; }

return $buf . $digi;

}

static function main(){

if(array_key_exists("update",$_POST) && $_POST["update"] === "save"){

$d = self::con();

$d->setAttribute(PDO::ATTR_ERRMODE, PDO::ERRMODE_EXCEPTION);

try{

$d->beginTransaction();

$s = $d->query("show table status like 'post_tb'");

$id = $s->fetch();

$p = $d->prepare("insert into post_tb (value) values (:v)");

$p->execute(array(

":v" => self::h($_POST['value'])

));

$d->commit();

echo self::jan($id['Auto_increment']);

}catch(PDOException $e){

$d->rollback();

echo "false";

}

Private Sub CommandButton1_Click()

Dim url As String
url = "http://192.168.1.4/request/index.php"

Dim xmlhttp As Object
Set xmlhttp = CreateObject("msxml2.xmlhttp")

Dim paramStr As String
Dim retCd As String

On Error GoTo e

For i = 2 To ActiveSheet.UsedRange.Rows.Count

    paramStr = "&update=save&value=" & Cells(i, 1).Value
    xmlhttp.Open "POST", url, False
    xmlhttp.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    xmlhttp.send (paramStr)
    
    Cells(i, 2).Value = xmlhttp.Status
    Cells(i, 3).Value = xmlhttp.responseText

Next i

Set xmlhttp = Nothing
MsgBox "done!"

Exit Sub

e:

    Set xmlhttp = Nothing
    MsgBox i & "行目でエラーが発生しました。"

End Sub

1

2

3

4

5

6

7

8

9

10

11

12

13

14

15

16

17

18

19

20

21

22

23

24

25

26

27

28

29

30

31

32

33

34

35

36

Private Sub CommandButton1_Click()

Dim url As String

url = "http://192.168.1.4/request/index.php"

Dim xmlhttp As Object

Set xmlhttp = CreateObject("msxml2.xmlhttp")

Dim paramStr As String

Dim retCd As String

On Error GoTo e

For i = 2 To ActiveSheet.UsedRange.Rows.Count

paramStr = "&update=save&value=" & Cells(i, 1).Value

xmlhttp.Open "POST", url, False

xmlhttp.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"

xmlhttp.send (paramStr)

Cells(i, 2).Value = xmlhttp.Status

Cells(i, 3).Value = xmlhttp.responseText

Next i

Set xmlhttp = Nothing

MsgBox "done!"

Exit Sub

e:

Set xmlhttp = Nothing

MsgBox i & "行目でエラーが発生しました。"

End Sub

Sub test()

Set xh = CreateObject("msxml2.xmlhttp")
Set sc = CreateObject("ScriptControl")
sc.Language = "JScript"
sc.AddCode "function jsonParse(s) { return eval('(' + s + ')'); }"

xh.Open "POST", "http://xxx.com/index.php", False
xh.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
xh.send ("&save=do")

If xh.Status = 200 Then

    Set js = sc.CodeObject.jsonParse(xh.ResponseText)
    MsgBox js.Name
    
End If

End Sub

1

2

3

4

5

6

7

8

9

10

11

12

13

14

15

16

17

18

19

Sub test()

Set xh = CreateObject("msxml2.xmlhttp")

Set sc = CreateObject("ScriptControl")

sc.Language = "JScript"

sc.AddCode "function jsonParse(s) { return eval('(' + s + ')'); }"

xh.Open "POST", "http://xxx.com/index.php", False

xh.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"

xh.send ("&save=do")

If xh.Status = 200 Then

Set js = sc.CodeObject.jsonParse(xh.ResponseText)

MsgBox js.Name

End If

End Sub